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ABSTRACT 


This thesis describes the design and implement of a prototype compiler for the 
functional programming language PHI. The design is highly modularized and the authors 
think this should facilitate the understanding of both concept and implementation. The 
front—end of the compiler implements machine independent lexical and syntactic analyzers; 
top—down parsing techniques are employed. The back-end implements a machine 
dependent one—pass semantic analyzer and code generator. 

Since this implementation is a prototype, it does not possess all of the qualities 
desirable in a full implementation. The basic constructs of PHI: functions and data 
definitions are implemented, as well as the integer, natural number, and boolean types. 
However, the necessary hooks are present and the design is mature enough to allow 


expanding the prototype to a full implementation. 
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I. INTRODUCTION 


A. BACKGROUND — GENERAL 

In its attempt to provide students with a well rounded background to the field of 
computer science, the computer science department at the Naval Postgraduate School offers 
courses covering recent developments in programming languages. One of the courses 
deals specifically with the methodology of functional, also known as applicative, 
programming. Both the theory and the practice of functional programming are covered, 
concentrating more on the practice than the theory. In order to fully appreciate the nuances 
of functional programming it would be desirable to provide the students with a functional 
programming environment. This would provide a first hand look at the fundamental dif- 
ference in methodologies when programming in functional languages as opposed to 
programming in traditional imperative languages. 

Of the languages currently supported in the department; LISP, on the UNIX! 
environment, comes the closest to meeting this requirement. Although LISP is considered 
a functional language by some, its many extensions and modifications actually brings it into 
the world of imperative programming. It is not a pure functional programming language. 

There are several additional problems associated with using LISP to teach techniques 
of functional programming. Modern LISP dialects do not support all aspects of functional 
programming. Most notably they lack the ability to define higher-order functions. 
Dynamic scoping and the semantics of the language make it a pedagogical nightmare to 
teach.[Ref. l:p. @-1] The goal of teaching functional programming would rapidly be 


overtaken by the necessity of explaining the idiosyncrasies of LISP. In an 11 week 


IUNIX is a trademark of Bell Laboratories. 





quarter, time devoted to LISP would significantly detract from instruction of functional 
programming. 

Recognizing the shortcomings of LISP, a pure functional language, PHI was 
developed by Dr. B. J. MacLennan for use in this course of instruction. The syntax of 
PHI closely follows that of standard mathematical notation. This means students should 
have little difficulty in learning how to write legitimate PHI statements. Instruction can 
now concentrate on joining these statements to create functional programs. Hopefully, this 
will lead to a greater understanding and appreciation of the methodology of functional 


programming. 


B. BACKGROUND — THESIS 

Creation of PHI solved the problem of finding a suitable language to use to 
demonstrate the methodology of functional programming. However, currently PHI 
programs are programs on paper only. There exists no programming environment for the 
PHI language. So it is impossible to machine execute PHI programs. This thesis attempts 
to remedy the above problem by providing the first component in a PHI programming 
environment — a prototype PHI compiler. 

Conventional compiler construction techniques were chosen for this implementation 
for several reasons. By choosing conventional techniques, the authors were able to 
address the problems associated with utilizing conventional methods for implementing a 
compiler for a functional language*. Additionally, realizing that both the language and 
system would change, the authors wanted a well documented and understood 
methodology. The cost of maintaining a system can be as much as three times the 
development cost [Ref. 2:p. 478]. Therefore, it was imperative to choose a methodology 


that supported a clean and structured design. 


2Specific problems and solutions are covered later in Chapters Two and Three 


Following conventional methodologies, the authors separated the PHI compiler design 
into a front-end? and a back-end‘. The overall general design of the PHI compiler is 
shown in Figure 1.1. The front-end, containing the scanner (lexical analyzer) and parser 
(syntactic analyzer) is essentially responsible for analysis of the external file containing the 
source program. The PHI compiler back-end couples semantic analysis with code 
generation to produce code suitable for execution on the target machine. [Ref. 3:pp. 5-6] 
The authors felt that a clear and distinct separation between parts would aid understanding 
of the system, simplify division of labor, and increase ease of development and 
maintenance. It should also result in greater flexibility for follow—on development in the 
PHI programming environment. As an example, the current front-end could be modified 


to support a PHI interpreter. 
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Figure 1.1 General Design of the PHI Compiler 





C. BACKGROUND — FUNCTIONAL PROGRAMMING 
Functional programming is a methodology in favor among academicians. Although 
applicative programming goes further back, it is generally agreed that, as a methodology, 
functional programming traces its roots to John Backus [Ref. 4:p. 404, Ref. 5:p. 65]. In 
3Design and implementation of the front-end is discussed in Chapter Two. 


4Design and implementation of the back-end is discussed in Chapter Three. 


his acceptance speech for the 1977 ACM Turing Award, Backus criticized traditional 
programming languages and programming styles. He went on to propose a new 
methodology of programming that involved "the use of a fixed set of combining forms 
called functional forms." [Ref. 6:p. 619] This methodology is known today as functional 
programming. 

1. Problems with Conventional Languages 

Backus feels [Ref. 6:pp. 613-619] that the basic underlying problem with 
conventional languages is the existence of the assignment statement. The assignment 
statement plays a central role in conventional languages and breaks programming into two 
worlds. Backus calls the mght—hand side of assignment statements, expressions, the first 
of these worlds. The second world is the world of statements, with the primary statement, 
of course, being the assignment statement. 

Several problems are associated with assignment statements. First, they permit 
programs to be held hostage through access to their variables. Since variables are used to 
imitate the machine's storage cells; assignment statements allow, even encourage, state 
changes to take place. This access, either direct or indirect, permits such problems as side 
effects, unintentional state changes, and aliasing to arise. It then becomes difficult to 
reason about the correctness of these programs, so proving simple programs correct is an 
arduous task and proving complex programs correct 1s virtually impossible. Additionally, 
by permitting the value of variables to be changed, the assignment statement makes 
temporal order of execution of statements critical. For example, the following two pieces 
of code produce dramatically different results depending on which statement inside the for 


loop is executed first. 


for (i = @; i != some_value; ++i) for (i = ©; i != some_value; ++1) 
if( i % 2 == @) DoSomething(i); 
continue; if(i % 2 == ©); 
DoSomething(1); continue; 


These problems interact so that it becomes extremely difficult to create new programs out of 
old ones. [Ref. 6:pp. 613 - 619, Ref. 1:pp. 1-2 - 1-2@] 

Another problem associated with assignment statements is that each produces only 
a one—word result. In effect, they force programmers to think in a word—at—a—time 
manner. For example, to apply a function to an entire array of values, the programmer 
must access each value individually. Not only is this wasteful of computer assets, but it 
results in what Backus refers to as the "von Neumann bottleneck" of conventional 
programming languages. [Ref. 6:pp. 613 - 619] 

2. Functional Languages 

Backus proposes the methodology of functional programming as the solution to 
these problems. Functional languages have removed variables and the assignment 
Statement from their syntax so that their basic building block becomes the function. It is 
through "the use of a fixed set of combining forms...plus simple definitions" [Ref. 6:p. 
619] that the programmer is able to build new functions from existing functions. It thus 
becomes possible to form a new program by combining two or more existing programs or 
functions together. 

The absence of assignment statements and variables removes the problems 
plaguing conventional languages caused by side effects, etc. because the program now 
operates exclusively in the world of expressions. This permits the programmer to maintain 
a clear conceptual view of the program. It is easier to understand and reason about the task 
the program is to perform [Ref. 5:pp. 65 - 69]. It now becomes not only possible, but 
practical to prove programs correct [Ref.6:pp. 624 - 625]. 

Another direct benefit stemming from the absence of side effects is order. The 
values of expressions are no longer dependent on the order in which they are evaluated. 
Therefore, functional languages provide a natural means of performing parallel 


computations [Ref. 7:p. 35]. Functional languages and the associated methodology of 
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functional programming may very well provide the key to programming the massively 
parallel computers entering service nowadays. All of the above benefits have applicability 
to ongoing research in the SDI program. 

The authors feel that functional programming can best be summarized by the 
following thought — assignment statements are to functional programming what GOTO 


statements are to structured programming. 


D. ASSUMPTIONS 

An IBMP personal computer/IBM compatible personal computer was chosen as the 
target machine for this implementation. The authors felt that the nature of the language and 
its intended use were better suited for the PC/personal work station environment as 
opposed to a mini— or main—frame time shared environment. The PC environment should 
provide greater flexibility and freedom when implementing follow-on tools for the PHI 
programming language. Also, future compiler improvements will not have to be concerned 
with extraneous interfaces to another system. Working with a PC environment eliminates 
the need to take into account the effects the PHI environment will have on another user of 
the system. The implementor is able to work with a system that remains constant — a 
known quantity. 

The assumed target machine configuration 1s based on the equipment available in the 
Naval Postgraduate School's computer science microcomputer lab. Each machine is 
configured with 64@K bytes of RAM, one (most have two) 20M byte hard disk drive, one 
1.2M byte 5 inch floppy disk drive, and the 8087 math co-processor; each currently 
operates under the MS~DOS® 3.x operating system. These machines are readily available 


to all computer science students at the Naval Postgraduate School, and many students own 


SIBM is a registered trademark of Internal Business Machines Corporation. 


6MS-DOS is a registered trademark of Microsoft Corporation. 
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personal computers with similar configurations. It is not necessary to utilize a hard disk 


when executing the PHI compiler. 


E. CONSTRAINTS 

As is the case with most implementation theses, time was probably the biggest 
constraint facing the authors. This involved making certain trade-offs; e.g. should the 
major effort be directed towards a full implementation of PHI while concentrating on a 
particular component of the compiler, or should the major effort be directed towards a full 
implementation of the compiler while concentrating on a subset of the PHI language? The 
authors felt that the greatest benefit could be gained by implementing a complete compiler. 
Having to actually face the issues and problems associated with designing, implementing, 
and interfacing a full compiler implementation would be much different than just reading 
about them in a text. Asa result, this thesis implements only a subset’ of PHI. 

Since PHI is an experimental language it 1s still undergoing changes and revisions. 
Trying to modify and update the compiler design with each version proved to be an 
impossibility. The authors were forced to freeze the design based on the language as it 
stood on @7 January 1987. Any follow-on work will need to update the front-end and 
back-end of the compiler to meet the requirements of these new versions of PHI. A 
description of the grammar as implemented and a description of the latest version of the 


grammar may be found in the Appendixes. 


’This subset is discussed in the individual chapters on the front-end and back-end. 


II. FRONT-END OF THE COMPILER 


The authors separated the design of the PHI compiler into two modules, a front-end 
and a back-end. These modules were then further subdivided to produce the general layout 
of Figure 1.1. The authors believe this modularization simplifies the design and will aid in 
understanding the system, thus decreasing future maintenance problems. 

The front-end of the PHI compiler is comprised of the scanner (lexical analyzer), the 
parser (Syntactic analyzer), and their associated error recovery routines. Two possible 
interactions between the lexical and syntactic analyzers were considered. The first 
incorporates the scanner into the parser, and tokens are produced by the scanner only upon 
request of the syntactic analyzer. Thus, this system acts like a pipeline. An alternate 
method is to allow the scanner to tokenize the entire source program, store the tokens in 
some data structure, and pass this structure to the parser. [Ref. 3:p. 10] 

For the prototype implementation of a PHI compiler, the authors based the design on 
the first interaction. Although the second method 1s conceptually very easy to understand, 
the authors think the current implementation is clean and will readily lend itself to future 
enhancements. Any input alphabet peculiarities are restricted to the lexical analyzer, and 
this independence should provide benefits for the next student(s) who work on the PHI 


programming environment. 


A. LEXICAL ANALYSIS — THE SCANNER 

The PHI compiler reads a source file of ASCII text which is fed to the scanner for 
lexical analysis. The principle task of lexical analysis is to separate or divide the source 
program into tokens for use during syntactic analysis [Ref.8:p. 84, Ref. 9:p. 155]. This 


is accomplished in the PHI compiler through a character—by—character examination of the 
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user's source file. These characters are assembled/grouped into the individual tokens 
which represent terminal symbols of the PHI grammar. Examples of some of the terminal 
symbols are operators, identifiers, keywords, and constants. A complete listing of the PHI 
tokens may be found in the header file for the scanner in Appendix E. 

The primary advantage to tokenizing the source program is that the design of the 
syntactic analyzer needs to take into account only one type of data unit — the token [Ref. 
3:p. 7]. This simplifies the design of the parser because provisions do not have to be 
made for handling white space and comments. The scanner has already removed them. 
Also, removing white space and comments and utilizing a fixed-length representation for 
the tokens saves space. Once tokenization is complete, the source program can be 
discarded and the compacted tokenized file can be utilized for further analysis. 

In order to correctly tokenize the source file there must be some discrete means 
available to accurately represent each token. There are several ways of describing tokens. 
One means available is to use a regular grammar. In this method "generative rules are 
given for producing the desired tokens" [Ref. 3:p. 142]. An equivalent, but different, 
method is to use finite-state acceptors, FSAs, to recognize tokens. The authors found it 
easier to visualize this as a recognitive vice generative problem. For this reason the various 
tokens were modeled using FSAs. An example of an unsigned number recognizer is 
shown in Figure 2.1. The interested reader is directed to Tremblay and Sorenson [{Ref. 
3:Chapter 4] for an excellent introduction to the practice of using FSAs to model tokens. 
The authors found that utilizing FSAs greatly simplified the design, coding, and debugging 
of the lexical analyzer — one picture was worth a hundred lines of code. 

The ideal grammar would allow each token to be uniquely and unambiguously 
identified. Once the lexical analyzer started on the path of building a token, it would be 


able to continue until the end with no backtracking. Due to limitations with the standard 
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Figure 2.1 Unsigned Number Recognizer 


ASCII character set, the designer of PHI used multiple keystrokes, or characters, to 
represent various operators in the language’. This resulted in compound token types. 
Also, as in other programming languages, PHI overloads certain operators, allowing them 
to do double duty? by taking on different context-dependent meanings. 

The problem of dealing with compound token types was easily handled through the 
use of a single lookahead character. For example, upon finding the character "-", the 


i) ‘ft 


scanner looks ahead to the next character to see if it is ">" ( —) or another "-" (--). If the 
next character is neither of these two, it indicates that the token is just the simple token "-". 
Distinguishing overloaded operators was solved by essentially ignoring it in the scanner! 
The authors took the position this is basically a syntax analyzer problem and there was no 
reason to complicate the scanner by handling it. The scanner just identifies a generic token 
type, e.g. SUB_, and lets the parser make the proper determination of its true meaning,e.g. 
SUB_ or NEG. 


There are several design decisions relating to the lexical analyzer worth noting. The 


authors, following the example of Pascal, C, and other languages, took the position that 


8Some examples of this are -> for 3, == for = and <> for #. 


For example, + and - can serve as either an unary or binary arithmetic operator. 


Ihe 


PHI's keywords!9 are reserved words and may not be redefined and used as identifiers. 
Alternate decisions would have been to distinguish keywords from identifiers based on 
context, as PL/I does, or to precede them by some special character, as ALGOL 6@ and 
ALGOL 68 do [Ref. 3:p. 91]. PHI has a very small set of keywords, smaller than C's, 
and the authors think that this decision makes life easier for the programmer by simplifying 
debugging of programs. It certainly made life easier for the authors. 

PHI's grammar makes no provisions for programmer comments. The authors 
originally implemented comments by requiring the programmer to explicitly indicate the 
beginning and end of each comment with a special character. After scanning the special 
character at the beginning of the comment, the lexical analyzer would ignore all following 
characters until the special character was once again found. Following conversations with 
PHI's designer this implementation was changed. Comments are now implemented the 
same way they are in Ada!!: the comment terminator is the end—of-line character. Not 
only did this simplify the recognizer for comments, but it also completely removed the 
problem of runaway comments. 

A name table is used to point to the names of all identifiers and constants. A symbol 
table was originally utilized but later discarded when the authors realized the syntax of PHI 
makes analyzing an abstract syntax tree easier than analyzing a flattened tree. The 
information normally associated with a symbol table is now held in the nodes of the tree. 
This permits just the first instance of each name to be placed into the name table. In other 
words, regardless of how many times and in how many scopes the identifier X is used, X 


appears only once in the name table. The token returned to the parser would indicate a 


10.4 complete listing of PHI keywords may be found in the header file for the scanner in Appendix E. 


1] Ada is a trademark of the Ada Joint Programming Office, Department of Defense, United States 
Government. 
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token type of identifier and the parser would then know to dereference the pointer to find 
the string containing the actual name, X. 

Because keywords are reserved, each potential identifier must first be compared 
against the possible keywords prior to being placed in the name table. The authors 
implemented a keyword table to simplify this process. Knuth (Ref. 1@:pp. 4@6-41@] has 
shown that a binary search is the most efficient way of searching an ordered table, using 
only comparisons. For this reason the keyword table is kept in alphabetical order. The 
lookup, which is at worst O(log n), is performed using a binary search of the keyword 
table. 

In an attempt to improve the efficiency of the name table, the authors implemented it as 
a hash table. McKeeman [Ref. 11:pp. 253-301] experimented with six different length 
dependent hash functions. He found that the function producing the best results involved 
Summing the internal representation of the first and last characters of the variable’s name 
with its length shifted four places to the left. This was the function utilized by the authors. 
The possibility of collisions is reduced by choosing a prime number as the table size. 
However, since this only reduces, not eliminates, the possibility of two or more names 
hashing to the same value; the authors had to make provisions for handling collisions. 

A variant of the chaining method of collision—resolution was chosen. In PHI's 
implementation, each of the name table slots/buckets holds a data structure that can contain 
both the name of the variable and a pointer to another structure of the same type. So each 
hashed value points to a linked list of names. This method offers the advantage of 
providing better performance than linear probing [Ref. 12:p. 89], is conceptually easy to 
visualize/work with, and also solves the problem of possibly overflowing the hash table. It 
does require slightly more memory to implement, but the authors determined that the 
benefits of this method far outweighed the slight increase in storage requirements. [Ref. 


12:pp. 83-93] 
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B. SYNTACTIC ANALYSIS — THE PARSER 

The purpose of the parser is twofold: 1) to determine if the program, as represented 
by the output from the scanner, is syntactically correct; 2) to impose a hierarchical structure 
on the token stream, fitting it into the abstract syntax tree which 1s the output of the parser 
[Ref. 8:pp. 7-8, Ref. 9:p. 7]. Traditionally, these tasks are done by either a top-down or 
bottom—up methodology [Ref. 8:p. 41]. Both methodologies use the tokens generated 
through lexical analysis. 

The terminology top-down refers to the order in which the nodes of the parse tree are 
constructed. Top—down parsing starts from the root of the tree and proceeds downward 
towards the terminal symbols at the leaves. The parse tree 1s constructed from the top to 
the bottom by applying productions of the grammar to generate strings of terminals and 
nonterminals. On the other hand, bottom-up methodologies start from the terminal 
symbols at the leaves and proceed upwards to the root. The parse tree is constructed from 
the bottom to the top by applying reductions of the grammar to generate single nonterminals 
from strings of terminals and nonterminals. [Ref. 8:pp. 4041, Ref. 9:pp. 134-136] 

It is generally agreed that the popularity of top-down parsing techniques is “due to the 
fact that efficient parsers can be constructed more easily by hand". [Ref. 8:p. 41] The 
authors can attest to the fact that the concept of top—down parsing is very easy to grasp. 
When parsing PHI, it is natural to begin with the start symbol of the grammar, 
BLOCKBODY, and work forward from there to analyze the token stream. So, partially 
because of its efficiency, but primarily because of its ease of understanding and use, the 
authors chose the top-down methodology of recursive—descent parsing to design and 
implement the syntactic analyzer. 

In recursive—descent parsers, separate procedures/functions are written to recognize 
each nonterminal of the grammar [Ref. 3:pp. 219-22@]. This technique gets its distinctive 


name “because nonterminals can appear in the mnght—-hand sides of each other's 
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productions, the procedures for recognizing nonterminals are recursive." [Ref.9:p. 150] 
To state it more clearly, the function to recognize nonterminal ‘A’ could end up calling itself 
recursively if either 1) 'A' appears on the right-hand side of the production describing ‘A’ 
itself, or 2) 'A' appears on the right-hand side of the production describing another 
nonterminal 'B' and 'B' appears on the right-hand side of the production describing 'A’. 
Regardless of how one looks at the nature of the technique, one usually identifies a stack 
with recursion. What made this technique so easy to implement was that the authors were 
able to use C's underlaying mechanism for handling recursive functions. The authors did 
not have to explicitly maintain a stack of symbols for each function call; instead, the 
information was Implicit in the stack of activation records resulting from each function call. 
Top-down parsing techniques, especially recursive descent, offer straightforward 
means of implementing a syntactic analyzer. However, these techniques are applicable 
only to a subset of the context-free grammars and it is essential that all left recursion be 
eliminated from the grammar [Ref. 3:p. 211]. In other words, there must not exist any 
productions describing nonterminal 'A' with 'A' appearing as the first element on the 
right-hand side of the production. Obviously, if this situation existed, it would be possible 
to present the parser with strings to parse that would cause it to enter “an infinite loop of 
production applications” [Ref. 3:p. 211], never to be heard from again. The PHI 
production QUALEXP = QUALEXP WHERE AUXDEFS is an example of this type of string. 
The parser would hang up looking for QUALEXP and would never leave this loop until the 
machine ran out of memory stacking activation records. In order to employ top-down 
parsing techniques with PHI the authors rewrote the PHI grammar to be right—recursive!?. 
However, as shown below, even the new grammar does not lend itself to "pure" recursive 


descent parsing techniques. 


12The right recursive syntax of PHI may be found in Appendix D 
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From the compiler writer's point of view the ideal grammar would allow the correct 
production rule to be applied in every step of the parsing process. Constructing the parse 
tree would then proceed in a completely deterministic manner. When this is not possible, 
there are two basic parser design methods for dealing with nondeterminism in the grammar 
[Ref. 9:pp. 151-152]. In the backtracking method, which is generally not applicable to 
recursive—descent techniques, the parser picks an arbitrary production and continues with 
the parse [Ref. 9:p. 151]. If the parse is successful it is assumed that the correct 
production was chosen. However, if an error 1s later discovered, the parser backtracks to 
the last choice, a new production is chosen, and the parser presses forward again. This 
process continues until either the parse is successful or the parser runs out of possible 
productions to chose from. The second method requires a modification to the grammar 
which results in a deterministic parser: the grammar is rewritten using a process called left 
factoring to avoid choices among nonterminals [Ref. 9:p. 151]. 

For the most part, the design of PHI is conducive to recursive descent parsing 
techniques. There are, however, several productions where this is not so. The result was 
that a degree of nondeterminism arose in the parser design. The authors attempted to solve 
this problem through a combination of left factoring and the employment of a simple single 
token look—ahead. This solution worked for all but the two productions described below. 
In one case a two token look—ahead was employed and backtracking was used tn the other. 
This is not to say that the authors are absolutely certain that PHI is not an LL(1) grammar 
or that backtracking had to be used. These solutions were used because they solved the 
problem at hand. 

A two token look-ahead was used for the production!? ARGBINDING = [ QUALEXP OP 
]. When the token '[' is found, a flag is set to indicate that an ARGBINDING is being 


parsed. The first look-ahead token is utilized when parsing the QUALEXP part. QUALEXP, 


134 complete description of the PHI grammar may be found in the Appendices 
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for example, may parse as TERM, which in turn may parse as either FACTOR or 
FACTOR*TERM. After succeeding on FACTOR, a look—ahead is employed to look for the 
MULOP, *, to see if a recursive search for another TERM should be initiated. This 
methodology works as long as QUALEXP was not called from ARGBINDING. If it was 
called from ARGBINDING, argbinding flag set, the operator * could be the trailing operator 
in the ARGBINDING production and not part of the TERM production. In order to make this 
determination, an additional look—ahead is utilized to look for the token ‘J’. If']' 1s found 
the QUALEXP production is terminated, e.g., term does not recursively call itself again, and 
the ARGBINDING production is allowed to proceed to completion. 

Backtracking was utilized when parsing productions of ACTUAL: ACTUAL = 
COMPOUND and ACTUAL = DENOTATION = FORMALS |-> ACTUAL. Legitimate PHI 
sentential forms produced by the production FORMALS = ( FORMALS*) are proper subsets 
of the sentential forms produced by the production COMPOUND = ( ELEMENTS ), excluding 
the empty compound statement. Since any number of identifiers may appear between the 
parentheses, it 1s not practical during the parse to utilize look-ahead to determine the 
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presence of the token "|->". In effect, the parser first realizes it was parsing a 
DENOTATION when it finds "|->". This problem was solved by designing the parser to 
apply first the compound production when presented with this choice. If "|->" is later 
found, the parser then backtracks!4 to the FORMALS production. The normal costs 
associated with backtracking were not evident in this isolated case. As described below, 
space trade-offs had previously been made and the parser was already working with an 


abstract syntax tree. The root to the subtree containing the previously parsed compound 


was simply passed to the FORMALS production to insure that the string could have been 


14 purist would say that this instance of backtracking means that the PHI compiler does not in fact 
employ a recursive—descent parser. 
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produced by FORMALS. After ascertaining FORMALS, the parser now continues the parse 
using the DENOTATION production. 

The production QUALEXP = QUALEXP WHERE AUXDEFS required a deviation from 
pure recursive descent parsing. The semantics of this production are such that a terminal 
(e.g., an identifier) may be used pnior to its definition. In itself, this does not present a 
major problem for the compiler writer. However, this construct also changes the scope of 
the identifier since the inner—most scope, in the form of the QUALEXP, is parsed first and 
the parser then works its way to the outer—most scopes, the AUXDEFS. This problem is 
analogous to that of mutual recursion in Pascal, without the benefit of the forward 
declaration [Ref. 4:p. 213]. 

Originally, the parser was designed to output the parse tree in flattened form, 
essentially a post-order walk of the tree. This design implemented traditional symbol-table 
management routines. However, after obtaining a clearer understanding of the semantics 
involved with the problems mentioned earlier, notably the production QUALEXP = 
QUALEXP WHERE AUXDEFS, the authors realized a traditional symbol-table would be too 
inefficient. Management of the table would take an inordinate amount of assets and be too 
unwieldy to work with. The authors solved this problem by maintaining the status of the 
parse in an abstract syntax tree so the output from the parser is now in tree form. This 
permits information originally held in the symbol-table to be maintained in the tree itself. 
The parser is able to analyze the source program by walking the tree and decorating the 
nodes with required information. Maintaining a binary tree in memory does require more 
space, but this is insignificant when compared with the benefits. 

Interestingly, maintaining the parse in tree form presented several additional benefits. 
The solution to the aforementioned problem of distinguishing between COMPOUND and 
DENOTATION became trivial because it was now simply a matter of returning to the 


appropriate subroot and rewalking the tree. Also, working with a binary tree permitted the 
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authors to perform a modicum of optimization in the parser. It becomes relatively 
straightforward to perform compaction on an actual tree. 

The authors think that this design offers maximum potential for future enhancements 
of the PHI programming environment. One possibility would be to use this front-end to 
drive a PHI interpreter. Modularization of the front-end in this manner simplifies 
functional understanding of the front-end and should lead to increased ease of maintenance 
and portability. To demonstrate portability, the authors recompiled the front-end and 
executed it on a 68@@@ based processor. This was accomplished with no modifications to 


the source program, just replacement of C run-time header files for the new target machine. 


C. ERROR HANDLING 


Tremblay and Sorenson [Ref. 3:p. 183] classify error responses into three categories: 


i Unacceptable responses 
1. Incorrect responses (error not reported) 
a. Compiler crashes 
b. Compiler loops indefinitely 
c. Compiler continues, producing incorrect object program 
2. Correct (but nearly useless) 
a. Compiler reports first error and then halts 
104. Acceptable responses 
1. Possible responses 
a. Compiler reports error and recovers, continuing to find later errors if they exist 
b. Compiler reports the error and repairs it, continuing the translation and producing a 
valid object program 
2. Impossible with current techniques 
a. Compiler corrects error and produces an object program which is the translation of 
what the programmer intended to write 


In the prototype PHI compiler, the authors have implemented a limited form of error 
recovery. The primary benefit of error recovery is to "prolong the compilation life of the 
program as long as possible before the compiler gives up on the source program”. [Ref. 
3:p. 11] This allows the maximum number errors to be discovered per compilation, 
shortening the edit, compile, debug cycle inherent to writing computer programs. 

The authors analyzed the intended environment and use of the PHI compiler and 


decided that lexical analysis and syntactic analysis were the most likely source of errors. 
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Lexical errors basically involve invalid characters or incorrect tokens. Common examples 
of these types of errors are unrecognized words, misspelled identifiers/keywords, or illegal 
characters. Syntactic errors relate to incorrect structure of the program. These errors arise 
when the programmer failed to follow the rules, productions, of the grammar. The form of 
the program is wrong. [Ref. 9:p. 226, Ref. 3:p. 185] 

One thing the error handler should not do is exacerbate the situation by reporting 
bogus errors or executing an erroneous program. To insure erroneous programs are not 
executed, the authors inhibited object file production if any errors were discovered. The 
authors do not believe the compiler should allow code generation to continue, or even 
begin, if the source program has errors. Often times one error leads to an avalanche of 
errors being reported and this is extremely annoying to the programmer. The authors 
attempted to minimize this situation, but found it impossible to eliminate completely 
because some errors feed on others. To insure the programmer would not become 
overwhelmed with error messages, the authors terminate the compilation after 1@ errors. 
Also, for programmer convenience, actual error messages are outputted instead of error 
codes. The authors saw no justification in using a cryptic code when a plain language 
message served much better. Since the authors anticipate students in functional 
programming classes to be primary users of the PHI compiler, error messages have their 
basis in the productions describing the PHI language. It is assumed that users of the PHI 


compiler have an understanding of PHI's syntax. 


III. BACK-END OF THE COMPILER 


A. OVERVIEW 

The back-end of the compiler consists of the semantic checker and code generator. 
Semantic checking and code generation are completed in one pass, and the output is a 
sequence of bytes, held in memory, which correspond to ASCII characters. These 
characters are then written to a text file, which the assembler uses to output an object file. 
This output is linked to the appropriate run-time routines to make a usable program. For 


the current implementation, a RASM86 assembler and LINK86)> linker are used. 


B. RUN-TIME ORGANIZATION 

Since PHI is a structured language with scoping and function calls, it lends itself to a 
stack—oriented run-time architecture. The stack is set up to accomplish two tasks: 1) to 
hold pointers to the current operands, and 2) to hold activation records for functions 
currently in use. Both of these tasks are described below. 

There is a 64 kilobytes limit on memory used while a program is running. This 
limitation is imposed because the memory is addressed as an offset from a base address, 
and the maximum offset is 64K. This space is competed for by the stack, current 
variables, and constants (see Figure 3.1). The stack grows from the top of this space 
down, and the variable space grows from the base of this space up, preventing wastage by 
either component. Because PHI is a functional language, a value is returned from each 
operation, and a pointer to this value is placed at the top of the stack. The returned value is 
placed in the lowest available space in the part of memory assigned to variables and 
constants. A heap allocation method is not currently used because 1) all data types 


currently implemented use only one word of memory, and 2) there is no fragmentation of 


15R ASM86 and LINK86 are trademarks of Digital Research, Inc. 
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memory because all types are currently static. If the next operation is a binary operation, a 
pointer to the second operand is placed on the stack, and the operation takes place using the 
two topmost pointers. The result is placed in memory, and the process begins afresh with 
new operands. If the next operation is unary (such as the negation operation), no change 


to the stack takes place and the variable in memory is altered as the program directs. 


Address 
64 Kb 


Values 
(Vanables and 


Constants) 





Figuine 5.1 
Memory Organization 


If the second operand of an operation is to be the result of a function call (e.g., "2 * 
f(x)'"), an activation record is placed on top of the pointer to the first operand and the 
function's value is calculated. Then, the activation record is deleted and a pointer to the 


function result is saved and placed at the top of the stack. 


Static Link 


Static Nesting Level 


Pointer to Value Space 





Figure 32 
Activation Record 


The activation record itself, Figure 3.2, contains three parts: the static link, the static 
nesting level, and a pointer to the address in memory where the function's first variable is 
stored. The static link is a one—word pointer which points to the static nesting level space 
of the previous activation record, and 1s used to traverse the stack from activation record to 
activation record, i.e. a Static chain. [Ref. 4:p. 77]. The static nesting level and the pointer 
to the base of the storage space for a scope's values are used to access variables and 
constants. In this design, a two-tuple (B, L) is associated with each variable. In this two- 
tuple, B represents the static nesting level and L is the offset within that level. By 
following the static chain for (current nesting level - target nesting level) links, the 
activation record of the scope of the target value can be accessed. Then, the address of the 
variable is calculated by adding L to the low address of the scope's variables. An alternate 
method would have been to store the values directly in the stack between or within 
activation records. However, this is a messy process when dealing with dynamic data 
structures such as sequences. Additionally, it 1s conceptually easier to divide the stack and 
the variables. 

Functions are implemented as calls to assembly language subroutines, with pointers to 
the arguments placed on the stack before calling the routine. Using this scheme, and noting 
the fact that PHI cannot have side effects, the implementation of recursion is 
straightforward. Whenever a function 1s called, its activation record is placed on the stack 


and pointers to its arguments are placed on top of the activation record. If the function is 
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recursive, the assembly language subroutine simply calls itself until the base of its 
recursion is reached or until stack overflow is reached. Figure 3.3 shows an example of a 
series of activation records called by a program with a recursive function. Note that the 
data definition ("answer") has no arguments and simply calls the factorial function. The 
factorial function, on the other hand, has an argument and it uses that argument as an 
operand. So, a pointer to that value is put on the stack and the next operand, fac (n - 1), is 
put on the stack as an activation record. When fac (n - 1) is evaluated, a pointer to its 
return value is placed on the stack. This cycle of evaluation, pop activation record, 


evaluation will continue untl the data definition "answer" is evaluated. 


Address 


Answer 
Activation Record 
(no actuals) 


Fac (5) 
Activation Record 


Activation Record 


Fac (3) 
Activation Record 


answer where answer == fac(5) where 
fac(n) == if n==Othens 
else n * fac(n-1) endif 





Figure 3.3 
Factorial Program and Activation Records 


As an example of the code generated for function calls and recursion, the following 


PHI program fragment is used : C (n) == ifn =0 then 1 else C (n - 1) * n endif. 
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This, of course, simply calculates the factorial of the integer n. Figure 3.4 is the 


listing of the assembly language segment which is generated from this fragment. 


Address/Machine Code Assembly Language 


0103 E94A00 


0106 B90000 
0109 E80000 
010C B8&0000 
010F E80000 
0112 E80000 
0115 E80000 
0118 3D0100 
011B 7509 

011D B80100 
0120 E80000 
0123 E92600 


0126 B90000 
0129 E80000 
012C B90000 
012F E80000 
0132 B80100 
0135 E80000 
0138 E80000 
013B E80000 
ULE ey 
O13F 57 
0140 BBO100 
0143 E80000 
0146 ESBDFF 
0149 E80000 


014C E80000 
O14F C3 


0150 jmp al0000 
al0001: 
mov cx,0 
call i_ formal 
mov ax,0 
call iputvalue 
call iequ 
call igetvalue 
emp ax! 
0126 jne al0003 
mov ax, 1 
call iputvalue 
014C jmp al0002 
alQ003: 
mov cx,0 
call i_formal 
mov cx,0 
call 1_ formal 
mov ax,1 
call iputvalue 
call isub 
call ppop 
push cx 
push di 
mov bx, 1 
call 1_mov 
call al0001 
call imult 
alQ002: 
call del_scope 
ret 
alQ000: 





Figure 3.4 
Assembly Language Output from Factoral Program 


The label "al0001" at address 0103 is the label of the subroutine which returns the 
factorial. When it is called, pointers to the values of the arguments are placed on the stack. 
If the subroutine is called before the base of the recursion is reached, a jump is made to 
label al0003. Then, the new actual value (n - 1) is calculated and placed in the low part of 


memory, a pointer to the value is puton the stack, and the values are prepared for calling 
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by the next subroutine (lines 0126 to 0143). The factorial subroutine is then called again. 
This process continues until the base of the recursion is reached; in this case a pointer to the 
integer value 1s put at the top of the stack (line 011D), and a jump is made to label al10002. 
Here, the subroutine "del_scope’ tears down the activation record on the stack and puts a 
pointer to the result of the function at the top of the stack. Clearly, recursion in the PHI 
program can be implemented by a parallel recursion in the assembly language output of the 
compuler. 

Another feature of the output code shown in Figure 3.4 1s that there is an unconditional 
jump around the function (lines 0103 and 014F). This is a result of the decision to output 
inline code in spite of the fact that functions can be called at random. There are both space 
and time penalties to be paid for these jumps, especially since each function must have a 
jump and label instruction bracketing it. However, the ultimate effect of all these jumps is 
to get to the label at the bottom of the program. The result is that all but one jump/label pair 
could be eliminated by an optimizer, making the penalty trivial. Another solution 
considered was to generate code for functions and the "main" program separately, then 
combine the two when printing the output from the code generator. This was not done for 
reasons put forth in the section that describes the semantic analyzer. 

Variable and constant storage 1s word oriented rather than byte oriented to take 
advantage of the 8@86 processor's 16 bit capability. Integers and naturals are both 
represented as single words, and booleans are represented as integers, either 1 or @. While 
this boolean representation 1s somewhat wasteful in terms of memory space, it allows fora 
great deal of overlapping in certain subroutines used in function calling and comparisons. 
It is planned to represent real numbers with two words of memory, and sequences using 
linked lists. Neither of these types have been fully implemented; however, there are 


provisions in the compiler for adding these features at a later date. 
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There is currently no dynamic allocation of registers. Some registers are used for 
specific purposes; for instance, the SI register is used to mark the top of the program stack, 
and of course the BP and SP registers are used to manage the machine's stack. In general, 
arithmetic processes take place in the AX register, using other general registers as 
auxiliaries as needed. When variable space is needed, the highest unused address space is 
allocated and, when a function is finished, only the result is saved in storage; all other value 
spaces are returned for use by the program. 

Error handling is probably the simplest part of the run-time routines. Any run time 
error such as overflow or division by Zero errors will result in an appropriate error message 
to the user (see Appendix O for a full listing of error messages). Then, program execution 


will terminate and control is returned to the operating system. 


C. SEMANTIC CHECKING and CODE GENERATION 

The PHI compiler utilizes the recursive descent technique to perform semantic 
checking and code generation in one traversal of the parser tree. In most cases, tree nodes 
are filtered through the semcheck function, which calls various procedures based on the 
name of the node. These procedures, in turn, call semcheck for each of their children, 
and the process is repeated until the leaves of the tree are reached. The function semcheck 
then returns a type (e.g., integer, real, boolean), which the parent node uses to determine 
the semantic correctness of its subtree. With the information returned from the semcheck 
function, the parent procedure can do one of three things: return a type, convert one node 
to a different type, or declare an error condition. 

Concurrent with semantic checking, code is generated. As noted above, this is 
assembly language code written to a buffer in memory. If an error condition is declared, 
however, a flag is set and code generation ends. Semantic checking will then continue until 


the tree is completely traversed or ten errors are accumulated; then, the semantic checking 
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process terminates. Unlike the parser, the semantic checker makes no attempt at error 
recovery; top-down checking simply continues normally from where the error was 
detected. 

Top—down semantic checking results in a neat, trim package for the back end of the 
compiler. Unfortunately, there are some problems that pure top—down checking will not 
solve. For instance, determining if there is a one—to—one match between formals and 
actuals for a given function involves some detours from top-down checking, as explained 
below. 

The scoping rules of PHI provided the largest challenge to writing the semantic 
checker. One solution is a multiplicity of stacks. The size of these stacks depends upon 
the number of its constituents visible at any one time. Usually, the proper match for an 
item is the one found closest to the top of the stack. However, because of the semantics of 
the "and" construct, checks against the variable-stack do not always follow this 
convention. 

There are four stacks used by the semantic checker: the type-stack, the variable-stack, 
the definition-stack, and the and-stack. All but the type—stack are implemented as linked 
lists. This implementation sheds the disadvantage of static length arrays at the cost of a 
slight increase in memory and temporal resources. The type—stack uses a fixed-length 
array of 30 entries because 1) the basic types of real, boolean, integer, natural, and trivial 
will be accessed most frequently, because they are the building blocks of every type and 
sequence, and because they can be more easily accessed from an array than from a linked 
list, 2) a list of 30@ type entries should not impose an extreme burden on the programmer, 
and 3) the planned implementation of sequences will be more straightforward if the 


type—stack is an array. 
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# of Bytes Link to Next Type 





Rigiine 95) 
Type—Stack Entry 


The type—stack, Figure 3.5, is meant to hold both the basic type definitions and user 
defined type definitions. This stack holds both the name of the type and the number of 
bytes needed in memory to implement the type. At compiler initialization, it contains the 
five basic types and user defined types are added as they are encountered. The begin—end 
construct of the language (not implemented yet) allows declared types to be visible over a 
specified range. It is planned to implement this construct by Setting a pointer to the top of 


the stack upon encountering the begin node and then popping the stack to that point after 


Link to Next Entry 


both of the node's subtrees have been checked. 


Variable Type | Formal Flag 


Figure 3.6 
Variable—Stack Entry 





The variable—-stack, Figure 3.6, holds all of the variables, including function names, 
currently seen by the semantic checker. Each entry holds a pointer to the hash table 
containing labels, a type, a pointer to the tree node defining it, and a flag to designate 
whether or not it is a formal. Whenever a variable name is encountered and the name is not 
a call to a function and not a data definition, it is put into the varnable stack. Then, when a 
scope is exited, the variables local to that scope are dropped from the stack. For example, 


after a function is defined, all of its formals are popped from the stack. 
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Definition Type Tree Node Pointe Link to Next Entry 





Figure ow 
Definitions Stack Entry 


The definitions—stack, Figure 3.7, contains all of the function and vanable definitions 
visible in a given scope; e.g., the declaration C: SR * $Z -> SB would put the definition C 
into the definition-stack. This entry would contain the type of C's return value (Boolean), 
a pointer to the tree node that contains C, and a pointer to a linked list which contains its 
argument types (Real and Integer). This last field will be null if the declaration is a data 
definition. This stack grows and shrinks in the same way as the type stack. 

The authors considered combining the definitions—stack and the variable—stack because 
of the similarity between their fields. In fact, one of the primitive implementations was 
designed in this way. However, this slowed down the search for both definitions and 
variables considerably, and the overhead needed to implement these two as separate stacks 
is small: three extra functions and one extra pointer. 

The need for the and-stack 1s derived from the scoping rules imposed by the AND 
construct. This construct allows a variable to be referenced before it is declared without the 
benefit of Pascal's forward declaration or equivalent. This is true of other constructs in 
PHI such as the WHERE construct. However, the AND construct cannot be parsed in such 
a way that the semantic checker can see all variables before they are used, because either 
subtree of the AND statement can define variables used by the other subtree. So, a program 
such as the one depicted in Figure 3.8 needs a vehicle by which it can detect that the 


variable d is defined later in the program. The and-stack is such a vehicle. 
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Figure: 35:6 
Tree With Forward Vanables 


When the semantic checker reaches the AUXAND node, Figure 3.8, a flag is set to 
indicate that AUXAND has been traversed, and a pointer is set to the top entry of the 
and—stack. "Notfound" is returned from the semcheck function when the variable d is 
reached, but, since the AND condition has been set, a pointer to d is put in the and-stack. 
Note that d is later defined in a data definition (DATAUXDEF node), and when both the left 
and nght subtrees of AUXAND have been checked, all variables in the and-stack are 
checked against variables in the variable-stack. If a match is found, d is defined and 
removed from the and-stack. In the event that a variable is not found when the AUXAND 
node's complete subtree has been checked, an error conditon (UNDEFINED VARIABLE) 
would be set. The semantic checker would recognize this condition because the top of the 
and—stack would not be equal to the mark placed at the top of the stack when the AUXAND 
node was entered. Nested AUXANDS are possible, but they pose no problem because the 


top of the and—stack is marked when the auxand node is traversed. 
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Variables and functions are represented in the run-time by a call to an assembly 
language subroutine, and each subroutine must have a discrete name. Also, there are 
several labels found throughout the program, and each of these must have a name. These 
names are generated by the "name" function found in the sem_u.c module. Each name 


begins with the letter "a", followed by 6 digits. Examples can be seen in Figure 3.4. 





Figure 3. 9 
Tree for Function f 


Function definitions presented a problem that was solved with a deviation from pure 
top-down semantic checking. When a function definition (FUNAUXDEF in Figure 3.9) is 
encountered by semantic checker, the following procedure would be followed (see Figure 


3.1@ for the function definition entry): 


funid node: 
check for definition-stack entry for "f" 
if not found 
retum (ERROR) 


get a pointer to the first formal of f 
get a pointer to the first formal of definitions-stack entry 


while both pointers <> Nil do 
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put variable in varstack; use type pointed to by the formal list 
advance both pointers 
end while loop 


if not (both pointers == nil) 
return (FORMALS MISMATCH) 
else 
put "f" in the variable-stack 
retum (Type of f = INTEGER) 
end else 
end. 


funauxdef node: 


left type = semcheck (Left Child) 
right type = semcheck (Right Child) 


if (left type <> right type) 
call a procedure which will either 
convert the right type to the left type or set an error flag. 
endif 
end. 


When a function is called with arguments, a similar process takes place (refer to 
igure 3.11): 


actualist : Input is a pointer to the actualist node 
Output is error condition 


Check definitions-stack for "f" 
if "f" not found 
set error (FUNCTION DEFINITION NOT FOUND) 


set elistptr to first element of element list 
elist (elistptr) 


check var stack for "f" 
if found, 
generate code to call "f" 
if not found 
if and_flag = TRUE 
put "f" inthe and stack 
else 
set error (FUNCTION NOT DEFINED) 
end. 


elist: Input is a pointer to the element list node 


if pointer->rptr <> nil 
elist (pointer->rptr) 


check type of element against corresponding formal type 


if types don't match 
set error (IMPROPER ARGUMENT TYPE) 
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else 
generate code to put pointers to argument values on the run-time stack 
end. 





Figure 3.10 
Definitions—Table Entry For Function f 


Type conversions are implemented in the semantic checker, albeit the code generator 
does not yet support this feature. The function hnumconvert (half number—convert, 
found in the module sem9O) will check to see if a conversion of the mght subtree of a node 
to the left subtree type should be accomplished. This is useful for function definitions, 
where the body of the function may be converted to the type the function returns, but the 
converse is not acceptable. In addition, the function numconvert (found in the sem0 
module) will convert either the left tree type or the nght tree type of a node. This is useful 
for certain arithmetic operations. The semantic checker considers integer—to-real and 
natural-to—real conversions to be legal. Natural to integer conversions are not implicitly 
done, since both of these types are represented in exactly the same way. On the other 
hand, an attempt to return an integer value for a function which has a declared type of 


natural will result in an error. 
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Freure 3.1/1 
Tree for Function Call 


Variables of simple type (1.e, natural, integer, or real) need not be declared before use, 
although such a declaration may be made. If a variable 1s undeclared when defined by a 
data definition, the semantic checker will attempt to classify it. If the semantic checker 
expects to find a boolean value, the variable is easily classified as a boolean and an entry 1s 
put into the variable table. If a numeric variable 1s expected, the semantic checker will try 
to type it as an integer; failing this, it will be classified as a real number. However, the 
AND construct alters this somewhat. If a variable is used before it is defined by a data 
definition, it must have been defined using the LETDEF construct. 

As noted in the section on run-time, some thought was given to generating all 
functions and data definitions to one buffer and the "main" program which calls these 


functions to another buffer. However, this would be an inefficient use of memory space, 


Be, 


since one buffer might run out of space while the other is under-utilized. Although there is 
a proliferation of jump calls in the output using one buffer, an optimizer could easily 


eliminate all but one call, as noted above. 


D. OPTIMIZATION 

There is no optimization module implemented in the PHI compiler. In this section an 
attempt will be made to identify three types of optimization which are suitable for 
implementation. Also, a small dissertation on what opumizations should not be considered 
is included. 

The first suitable type of optimization is constant folding. The purpose of constant 
folding is to eliminate multiple consecutive constants in arithmetic expressions [Ref 3:p. 
612], and the function numconvert in module sem0 makes an excellent structure in 
which to implement this optimization. This is because most arithmetic operations call this 
function. It would be straightforward to put a function that tests the left and nght children 
of an operand node to see if they are constants, then perform the operation in the compiler 
and generate code for a constant call. However, since the division operators do not call 
numconvert, the constant folding function would have to be inserted in idiv and rdiv 
also. 

The other two optimizations are post-code generation optimizations. The first one 
considered is jump optmization. This should be the most worthwhile to implement: if the 
number of functions and data definitions is n, n > @, there will be n - 1 unnecessary 
unconditional jump statements and labels. 

These jump statements can be eliminated by replacing the first "jmp" statement with a 
jump to the last label in the code; then, because "jmp" is not used for anything except to 
circumnavigate functions and data definitions, all other unconditional jumps and their labels 


can be eliminated. 
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The last type of optimization 1s a form of peephole optimization. Occasionally, there 
will be a "call ppush" statement followed by a “call ppop” statement. This is unnecessary, 
and can be eliminated. The 8086 assembly code equivalent of "push" followed by "pop" 
should not occur in the present design. 

Dead code optimization eliminates code inside a jump when that code contains no 
labels. It is not necessary to implement this type of optimization with the current design, 
since unconditional jumps are only used to bracket functions and definitions. However, if 
One accepts the premise that programmers occasionally make mistakes, it might be 
worthwhile to keep track of which functions are called and eliminate code for those which 


are not. A message to the programmer concerning this circumstance would be useful, too. 
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IV. RESULTS & CONCLUSIONS 


A. RESULTS 

The implementation described in this study demonstrates the design and 
implementation of a compiler for the functional programming language PHI. Since this 
implementation 1s a prototype, it does not possess all of the qualities desirable in a full 
implementation. However, the necessary hooks are present and the design is mature 
enough to allow expanding the prototype to a full implementation. 

The PHI compiler front-end implements machine independent lexical and syntactic 
analyzers. This implementation is complete and faithfully follows the syntax of PHI — 
based on the design of the language as of ©7 January 1987. In deciding which modules to 
include in the front-end and back-end, the authors were originally guided by the traditional 
methodology of placing the analysis functions in the front-end and generative functions in 
the back-end [Ref. 8:p. 2]. However, as the design of the PHI compiler progressed, the 
authors removed semantic analysis from the front-end and combined it with code 
generation. This produced a one—pass semantic analysis/code generation phase. 

The PHI compiler back-end implements a machine dependent one—pass semantic 
analyzer and Intel 8086 code generator. The semantic analyzer implements the basic 
constructs of PHI: functions and data definitions may be defined, and the integer, natural 
number, real number, and boolean types are fully implemented. Implementation of code 
generation is congruent to that of the semantic analyzer, with the exception that the real 


number data type has not been implemented. 
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B. CONCLUSIONS 

It is possible, using traditional technologies to design and implement a compiler for the 
functional programming language PHI. It is not possible to utilize either pure recursive 
descent or pure deterministic techniques for this implementation. The syntax/semantics of 
the language forced a degree of non—determinism, and one instance of back—tracking was 
required in the PHI compiler front-end. 

The overall design is highly modularized facilitating the understanding of concept and 
implementation. The authors think that this approach will greatly reduce maintenance costs 
and provide greater flexibility in making changes and additions to the PHI programming 
environment. It should be possible, for example, to use the front-end described in this 
thesis to drive a PHI interpreter. Being able to abstract out this front-end and use it 
without change should make the implementation of a PHI interpreter relatively simple. 
Modularizing the design also increases portability of the compiler to other machines. To 
demonstrate portability, the authors recompiled the front-end and executed it on a 680@0@ 
based processor. This was accomplished with no modifications to the source program, just 
replacement of C run-time header files for the new target machine. 

Removing the semantic analyzer from the front-end permitted coupling semantic 
analysis with code generation. The fixed-length buffer design of the code generator is 
suitable for this prototype implementation but should be redesigned utilizing dynamic 
buffer allocation methods in follow on implementations. The authors think that utilizing a 
single pass through the parse tree is practical for the basic constructs of PHI and believe 


this methodology is suitable for future designs of the PHI compiler. 
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V. FURTHER RESEARCH 


Further research may be broken down into two major areas: short and long range 
projects. The former may be further broken down into two main areas: adding 
unimplemented features and improving the PHI programming environment. On the other 
hand, all long-range projects involve only the programming environment. AI] of these 
areas are discussed below. 

In the prototype of the PHI compiler, both Real and Compound variable types remain 
unimplemented. Compound variable types consist of sequences, the Trivial type, user 
defined types, and tuples. Although all of these are recognized by the parser, the semantic 
checker will not recognize complex types and no code will be generated. The Real type is 
recognized by the semantic checker, which can discern if conversion from an integer or 
natural type should be accomplished; however, no code is generated to implement this type 
in the run-time structures. Note also that operators which operate solely on complex types 
and reals (e.g., the real divide and concatenate operators) are not implemented. 

One other operator not implemented is the "I->" operator. In addition, argument 
bindings, functionals, and FILEs are not recognized by either the semantic checker or the 
code generator. 

Short-range improvements to the PHI environment may come either after a full 
implementation is accomplished or may be developed concurrently with the full 
implementation. Admittedly, the current environment is analogous to instrumentation on a 
helicopter: there is just enough to know that the system is running! The environment could 
be improved by implementing the interactive mode of PHI, as opposed to the current batch 
mode. A sample interactive session of PHI may be found in [Ref. l:pp 1-17]. Also, an 


interpreter would be a good starting point toward developing a practical, working 
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environment for PHI. As noted above, the front end of the prototype compiler may be 
adapted for this purpose; alternatively, due to the structual similarities between PHI and 
LISP, an ambitious researcher may wish to write an interpreter in LISP. 

One final short-range improvement which is not covered by either category would be 
to allow more than 64K of run-time memory. It would be worthwhile to take advantage 
of the large amount of memory most modern microcomputers have, especially since 
sequences and recursion, upon which PHI is based, gobbles up memory with abandon. 

When the PHI compiler becomes a serious user's tool, some long-range research will 
become viable. Sophisticated input and output would be a vital consideration, and the 
minimal I/O methods now in use would need substantial improvement. The most 
ambitious researchers in this direction should consider a bit-mapped display with the 
possibility of a syntax—directed editor. Also, based on the authors’ limited experience in 


PHI programming, a debugger would be a necessary tool for the serious programmer. 
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APPENDIX A 
THE FUNCTIONAL LANGUAGE PHI — ® 
(CONCRETE SYNTAX OF ® — 1@/16/86 ) 


GRAMMATICAL NOTATION: 


Sy 
C 
Both '(C),C92,...,Cn}' and se mean exactly one of C1, Co,..., Ch. 
Ch 
Cj 


Similarly, [C1 1... !Cnl! and | mea at most one of C },..., Cn, The notation 'C™’ 
C 


n 


means zero or more Cs; 'Ct' means one or more Cs; 'CD ...' means a list of one or more 
Cs separated by Ds. Terminal symbols are quoted when they could be confused with 
metasymbols. 


Grammar: 
_ QUALEXP \ 
7B OSESOENS - LET DEFS ; BLOCKBODY 
[ID] FORMALS = QUALEXP 
DEF = ID : TYPEEXP 
TYPEID [FORMALS] = TYPEEXP 
EXPRESSION 
EAE QUALEXP WHERE AUXDEFS } 
AUXDEFS = AUXDEFAND... 
AUXDEF = [ID] FORMALS = EXPRESSION 
FORMALS 2 ve \ 
= (FORMALS, ... ) 
EXPRESSION = {EXPRESSION V] CONJUNCTION 
CONJUNCTION = [CONJUNCTION A] NEGATION 
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NEGATION =  [~] RELATION 


RELATION = [SIMPLEXP RELATOR] SIMPLEXP 
RELATOR = {=I424I>s 1 < |< ee uieeuee 
SIMPLEXP = [SIMPLEXEP ADDOP] TERM 
ADDOP = (a este eee ey 
TERM = (TERM MULOP] FACTOR 
MULOP = {x 1/1 +} 
af : 
FACTOR = [ - ] primary 
Spee APPLICATION 
PRIMARY  DPLICATION 
APPLICATION = [APPLICATION] ACTUAL 
ID 
DENOTATION 
CONDITIONAL 
ACTUAL = COMPOUND 
ARGBINDING 
L BLOCK ' 
FILE “ CHAR** 
GHAR 
DENOTATION = DIGIT* [. DIGIT* ] 
FORMALS |> ACTUAL 
CONDITIONAL = IF ARM ELSIF ... [ELSE EXPRESSION] ENDIF 
ARM = EXPRESSION THEN EXPRESSION 


(ELEMENTS ) 
COMPOUND = '{’ ELEMENTS '}' 
< ELEMENTS > 


ELEMENTS = [(QUALEXP, ...] 
OP 
ARGBINDING = '['§ OP QUALEXP ? 'J' 
QUALEXP OP 
OP = {, | RELATOR | ADDOP | MULOP | ! } 
BLOCK = BEGIN BLOCKBODY END 
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DEFS = DEF AND... 


TYPEEXP = TYPEDOM [ > TYPEEXP ] 
TYPEDOM =  TYPETERM[+TYPEDOM ] 
TYPETERM =  TYPEFAC[ X TYPETERM ] 
TYPEPRIMARY 
TYPEFAC = | TYPEPRIMARY 
ID << TYPEEXP, ... >> 
ID 
TYPEPRIMARY = PRIMTYPE 
(TYPEEXP ) 
PRIMTYPE = (RIZINIBII1ITYPE) 


For batch use, a program is considered a BLOCKBODY; for interactive use it is considered a 
SESSION: 


SESSION =  COMMAND+ 
DEF 
aia : QUALEXP } 
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APPENDIX B 


THE FUNCTIONAL LANGUAGE PHI — ® 
(CONCRETE SYNTAX OF ® — ©3/@3/87 ) 


GRAMMATICAL NOTATION: 


Both (Cj,C5,...,G,) ane 


Similarly, (Cie tenn ana] ; 
C 


Ci 
Ch 
Cl 


n 


mean exactly one of C), Co,..., Cp. 


mean at most one of C j,..., Cp. The notation 'C*' 


means zero or more Cs; 'Ct' means one or more Cs; 'CD ...' means a list of one or more 
Cs separated by Ds. Terminal symbols are quoted when they could be confused with 
metasymbols. 


Grammar: 


BLOCKBODY 


DEF 


QUALEXP 


AUXDEFS 


AUXDEF 


FORMALS 


EXPRESSION 


CONJUNCTION 


{ QUALEXP } 

LET DEFS ; BLOCKBODY 

REC] (ID, ...: TYPEEXP (BE! IS }] [ID] FORMALS = QUALEXP 
TYPEID [FORMALS] = TYPEEXP 


{ EXPRESSION \ 
QUALEXP WHERE AUXDEFS 


AUXDEF AND ... 


[ID] FORMALS = EXPRESSION 


{ TOR MAG! ees) } 


[EXPRESSION V] CONJUNCTION 


[CONJUNCTION A] NEGATION 
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NEGATION = [ ~ | RELATION 


RELATION =  [SIMPLEXP RELATOR] SIMPLEXP 
RELATOR = C= (eeleee < | = | 2 lele 
SIMPLEXP =  [SIMPLEXEP ADDOP] TERM 
ADDOP = Pea lesen i} 
TERM = [TERM MULOP] FACTOR 
MULOP = CX eer ls le) 
FACTOR = [ * | prmary 
APPLICATION 
PRIMARY = PRIMARY 
APPLICATION 
APPLICATION = [APPLICATION] ACTUAL 


ID [ « TYPEEXP, ...» ] 
DENOTATION 
CONDITIONAL 
COMPOUND 
ARGBINDING 


ACTUAL 


BLOCK | 
{ FILE| STREAM }'CHAR®™' 


'CHAR™' 

PiGine |. DIGIT | 

NIL 

FORMALS | ACTUAL 


DENOTATION 


CONDITIONAL 


IF ARM ELSIF ... [ELSE EXPRESSION] ENDIF 


ARM EXPRESSION THEN EXPRESSION 


'[’ ELEMENTS '‘J' 
(ELEMENTS ) 

'(’ ELEMENTS '}' 
< ELEMENTS > 


COMPOUND 


ELEMENTS 


[EXPRESSION , ...] 


OP 
[' | OP ACTUAL ! ‘}' 


ACTUAL OP 


ARGBINDING 


OP {, | RELATOR | ADDOP | MULOP | SUB } 
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BLOCK - BEGIN BLOCKBODY END 


DEFS = DEF AND... 
TYPEEXP = TYPEDOM [ — TYPEEXP |] 
TYPEDOM = TYPETERM [ + TYPEDOM | 
TYPETERM = TYPEFAC [ X TYPETERM ] 
: 

TYPEFAC = ey ee 

| [« TYPEEXP, ...» ] 
TYPEPRIMAR Y — PRIMTY PE 

( TYPEEXP ) 

PRIMTYPE = {RIZIN1IBI11TYPE} 


For batch use, a program is considered a BLOCKBODY; for interactive use it is considered a 
SESSION: 


SESSION = COMMANDt 
LET DEF 
COMMAND 5 { QUALEXP \ ; 


APPENDIX C 
ASCII REPRESENTATION OF — ® 


Asc 





2 


*« 
Note: 
+ 


n 


( 
( 
( 
( 


BLOCK 


BLOCKBODY 


DEES 


DEF 


QUALEXP 
AUXDEFS 
AUXDEF 


FORMALS 


EXPRESSION 


CONJUNCTION 


NEGATION 


RELATION 


APPENDIX D 
THE FUNCTIONAL LANGUAGE—® 
( RIGHT—RECURSIVE GRAMMAR ) 


...) Means zero or more occurrences 
...) | Means one or more occurrences 
ae) 


means from zero to n occurrences 
x |y) means either x or y, but not both 


BEGIN BLOCKBODY END 


LET DEFS; BLOCKBODY 
QUALEXP 


ee 


DEF (AND DEFS). 


(ID)! FORMALS = QUALEXP 
ID : TYPEEXP 


TYPE ID (FORMALS)! = TYPEEXP 
EXPRESSION (WHERE AUXDEES)* 


‘= AUXDEF (AND AUXDEF) 


(ID)! FORMALS = EXPRESSION 


::= (FORMALS (,FORMALS) ) 
ID 


:= CONJUNCTION ( V CONJUNCTION). 


‘= NEGATION( A NEGATION). 
-:= (~)! RELATION 


‘:= SIMPLEXEP (RELATOR SIMPLEXP)! 
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RELATOR 


SIVMIPLEAP 


ADDOP 


TERM 


MULOP 


FACTOR 


PRIMARY 


APPLICATION 


ACTUAL 


DENOTATION 


CONDITIONAL 


ARM 


* 
::= TERM (ADDOP TERM) 


2 ° a_ : 
= 
ee 


A 
-:= FACTOR (MULOP FACTOR)" 


* 
/ 


ate 
° 


= + PRIMARY 


- PRIMARY 
PRIMARY 


APPLICATION (! APPLICATION) 


(ACTUAL)* 


ID 
DENOTATION 
CONDITIONAL 
COMPOUND 
ARGBINDING 
BLOCK 


FILE ‘(CHAR)’ ’ Note: CHAR can = ASCII 32... ASCII 126 





= (CHAR) ” Note: CHAR can = ASCII 32 ... ASCII 126 


(DIGIT)* Note: DIGIT can= @...9 
(DIGIT)* . (DIGIT)t 
FORMALS |—> ACTUAL 


ALF (ALFNUM). Note Ar can — 4...Z, A...Z 
ALENDUM@ecan'= a...Z, A...Z Oie9 


e 


2 om 


IF ARM (ELSIF ARM) (ELSE EXPRESSION)! ENDIF 


"= EXPRESSION THEN EXPRESSION 


>» 


COMPOUND -:= ( (ELEMENTS)! ) 
{ (ELEMENTS) } 
< (ELEMENTS)’ > 


ELEMENTS ‘= QUALEXP(,QUALEXP) 
ARGBINDING = [op] 


[ OP QUALEXP ] 
[ QUALEXP OP ] 


OP i=, 

RELATOR 

ADDOP 

MULOP 
TYPEEXP = TYPEDOM (> TYPEDOM). 
TYPEDOM = TYPETERM (+ TYPETERM) 
TYPETERM "t= TYPEFAC ( * TYPEFAC)* 
TYPEFAC == TYPEPRIMARY@ 

TYPEPRIMARY 

ID <<TYPEEXP (,TYPEEXP) >> 
TYPEPRIMARY _::= (TYPEEXP) 

ID 

PRIMTYPE 
PRIMTYPE eK 

iL 

N 

IB 

1 

TYPE 

FOR INTERACTIVE IMPLEMENTATION OF @® 

SESSION ::= (COMMAND)~ 
COMMAND "= (DEF | QUALEXP) ; 
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APPENDIX E 


ROCK COMPILER HEADER FILES 


a a ee ek a ee RR ARE KR ARR ER REAR EKER KR KK KK KX 


ia ito Pose CouloiNa HEADER ETERS REQUIRED BY THE ROGK COMPILER 


2K KK KK kkk kk ek kk kk KR KK KKK KKK KKK KKK RK KKK KK KKK KKK KKK KKK KK KKK / 


* 


ee Eee ee ee a ee RRR RR RRR RARER AKER ARR KER EKER 


* PUBLIC DOMAIN SOFTWARE 
x Name scanner definitions 

x File scanner.h 

= Authors Magen ciemte OLE ye cadote d.5., CONNELL 

* Started 107 107 86 

* Archived dea Aaa ea At i 

* Modified 01/10/87 - Update keywords ule 


KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KK KKK KKK KKK 


* This file contains definitions used by the scanner,parser, and 
* error recovery routines. 


KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KEKE KK KKK KKK KEK KKK KKK KKK KKK KK KKK KK KK 


* Modified Only 807 6) Conreceions to comply with latest definitions 


* 


KEK KKK KKK KKK KK KEK KKK KE KKK KKK KEKE KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 


of the language and update keywords. JC 


#ifndef EOFs 
#define EOF _ 2 
#define FALSE 0 
#define TRUE 1 
#define BYTENUM 2 
#define MAX KEYWORDS 17 
#define NAMESIZE 1 
#define MAXLINE 80 
#define TABLESIZE OT 
pier Se rig 
#define EOLN_ 3 
#Gefine LEQ_ 4 
#define NEQ_ 5 
Meee ine ST SEQUENCE — 6 
#deZine GEQ_ 7 
#define END SEQUENCE_ 8 
#define EQ_ 2 
#define ADD_ 10 
#define SUB_ 1 
#¢define MULT _ ile 
#define IDIV_ ihe 
#define RDIV_ 14 
adefine SEMI _ iS 
geerine SUBSCRIPT _ 16 


/* system dependent - sizeof(in 
/* treally 18, ranges from 0 — 1 
f= Llengtn Of ste, lc chars. |" \ 


© =) Gi 


/* hasn const/size of name array 


/* General Token Types */ 
of symbols can be found at end of list */ 
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) 


To OE oe A et Ot ee 


#define COMMA_ ig 
#define LTPAREN _ 18 
#define RTPAREN_ 1g 
#define EQUIV, 20 
#define ORLOG_ 7 ik 
#define ANDLOG_ 22 
#define NEGLOG _ 23 
#define COLON _ 24 
#define CAT_ 25 
#define LTBRAKET_ 26 
#define RTBRAKET_ 27 
#define LTSQUIG_ 28 
#define RTSQUIG_ 22 
#define EMPT LIT_ 30 
#define RTARROW_ 31 
#define LINERTARROW 32 
#define LITERAL a3 
#define IDENTIFIER _ 34 
#define CONSTANT_ 35 
#define REAL _ 36 
+define INTEGER _ 30 
#define NATURAL_ 38 
#define BOOLEAN 39 
#define TRIVIAL_ 40 
tdefine CHAR_ 41 
#define STRING _ 42 
#define STAR_ 43 
#define POS_ 44 
#define NEG 45 
#define KW_ 46 
/* eof, error, unknown token, 
rr es ae VN ha 
ideéntteier, “constane, 


Unary plus, 


#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
+define 
#define 
#define 


AND_ 
BEGIN_ 
ELSE_ 
ELSIF_ 
END _ 
ENDIF_ 
FILE_ 
GREATER _ 
IF 

IN_ 
LESS _ 
LET_ 
NOTIN_ 
READ _ 
THEN _ 
TYPE 
WHERE _ 
WRITE 


unary minus, 


worn Of Ww Nr © 


ee ee oo oo 
jw NM F © 


ee 
oO Ul 


i 
~J 


/* KEYWORD 7 
<=, <>, S, >=) 7, =, +) =p ie eS 
& Jee {, }, a =—7, Rese literal, 
SN, $B,$1, character, strane ace 
keyword x7 


/* Keywords */ 
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#define 
See 


enar 
nae bones 


ee 


CALLOC (y,x) (Ge calloec(y,sizeof(x))) 
NSErUce { 


name {NAMESIZE}; 
NSerieces* link? 


typedef struct NStruct NameRec; 


extern 
ex Lenn 


#endif 


enar fcaltloc() >: 
Ear Sia OC () - 


oo 


i= 


Struecure to hold names 


/* user prog 


[RRR KKKKKKKEKKKKEKKKKKKKKKKKKKKKKKKKKKKAKKKKKKK AX KKK RAK KX Ae 


* PUBLIC DOMAIN SOFTWARE % 
* * 
x Name me parser definitions * 
x File parser.h x 
x AULNOES Maj E.J. COLE / Capt J.-B 23Gemipmm x 
* Started LOY 207386 x 
* Archived 12) 86 * 
* Modified x 


01/12/87 - update NodeStruct definition JC 


KKK KEKE KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KEKKKK KKK 


* This file contains definitions used by the parser x 
KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KK KKK KK KK KKK 
* Modified : 01/10/87 - update NodeStruct to hold the type GEWimeumm 


x node * 
KKKKKKKKKKKK KKK KEK KEKE KKKEKKKKKKKEKKKKKKKKKKKKKKKKKKKKKKKKKKK KK KK XK RR 


#ifndef LETDEF 

#define LEITREE yeah 
#define DEFAND te 
#define KINDEF a3 
#define FONID 74 
+#define FUNDEF To 
#define DATADEF 76 
#define TD Ea 77 
#define TDEFFUN 78 
#define DATAAUXDEF 719 
#define FUNAUXDEF 80 
define AUXAND i 
#define ACTUALLIST 82 
#define SEQUENCE 83 
#define FORMAL 84 
#define ELE EST 85 
#tdefine EMPTYCOMPOUND' 88 
#tdefine EMPTYSEQUENCE 89 
#define ARGBINDOP 90 
#define ARGLEADOP 91 
define ARGTRAILOP 92 
#define TYPEPEOS 93 
#define TYPELTIMES 94 
#define TYPEEXPLIST 95 
#define Eee ib 
#define RIGHT Ei 
#define ERROR _ = 
define BUFSIZE Ve 
typedef int NodeType; 


struct NodeStruct { 


NodeType name; 

long index; 

Goh type; 

int ine 

enar label [8]; 
long addr; 
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/* 
/* 
Ves 
/* 
/* 
/* 
i 
/* 
/* 
/* 
/* 


operator node in tree 

int defined as the operator 
pointer to constant, litera 
the type of the node 

line no in source text where 


token can be found 
Label used by functions to 
refer to code 


Addr of the var or £Euneoue 
value in the run time*sS vee 
memory 


a 
ge / 
ae! 
Bie! 
aly 
iy! 
“7 
77 
ay! 
“7 
a! 


a a a 


Struct NodeStruct wbsicne 
SELUCE NodeSer uct *rpUr, 


b; 


typedef 


NodeRec 


char 


extern 
extern 


excern 
ex<clern 
extern 
exCern 


struct NodeStruct NodeRec, 


*CreateNode(); 
*NodeName () ; 


IAC num errors; 
apit argbind; 


Chae “cal loc () + 
Ghar “malloc () ; 
ErrorHandler(); 
WriteErrors(); 


*nodal; 


/* 
/* 


/* 
/* 
/* 
/* 


/* 


left ptx 
Eight, OcY 


global var-list number errors 
during scan and parse 

Global flag - used to make PHi 
deterministic 


aef used from <stdlibs .h> 


[RRR KKKKKKKKKK KKK KKK External VELILey Functions **® RRR KKK KKK KK KK / 


extern 
extern 
extern 
extern 
extern 
extern 
extern 


NodeRec *CreateNode() ; 
cnar *NodeName (); 
MakeNewRoot (); 
IsFormal(); 

TBall(); 

Bakem{) ; 

long ByPass(); 


#include <scanner.h> 
menrecluce <errors.h> 


fendif 
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= / 
</ 


[RR KKKKRKKKKKEKKREKKKKKKKKKEKKKEKKKKKKKKKEKKKKKKKKKKKKKKKKKKKAKAK XXX KX Ae 


PUBLIC DOMAIN SOFTWARE 


Name 
File 


+ 4+ + + + 4 


Authors : 
Started : 
Archived 


x Modified : 


KKK KKK KEK KEK KKK KEK KKK KK KKK KKK KKK KKK KKK KKK KKK KEK KKK KKK KKK KKK KKK KKK KKK KK KKK 


* This file contains definitions used by the error recovery routines. 


error file definitions 
erors.h 


Maj) E.J. COLE / Capt J.E. GONME@s 


O17 207 87 
4/27/87 


+ + 4 + + 4 


x 


KKK KKK KKK KK KK KKK KK KK KKK KKK KKK KEK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 


x Modified 


KKK KKK KEE KEK KKK KK KEKE KEKE KK KKK KK KKK KE KKK KKK EKER KKKKKEKKEKKEKKKKEKKKKKKKKEKX / 


#ifndef 


#define 


MAXERRORS 


MAXERRORS 


10 


x 


[RK KKKKKKKKKEKK KK KKK KKK KKK PARSER ERRORS KKK KKKKKKKRKKKKRKKKKKKKKKKKKKKKE K / 


#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 


#define 


#define 


#define 


#define 
#define 
#define 
#define 
#define 
#define 
#define 


#define 
#define 


#define 
#define 
#define 
#define 
#define 


#define 


#define 


ERRO 
ERR1 
ERR2 
ERR3 
ERR4 
ERRG 
ERR6 
ERR? 
ERR8 


ERR9 


ERR a 
ERR_b 


ERR_c 
ERR 
ERR e 
ERR_f 
ERR_g 
ERRe 
ERR_i 


ERR_3 
ERR_k 


ERR 1 
ERR_m 
ERR on 


ERR_o 
ERR_p 


Oar3atnom Se Ww Nr © 


,* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
i 
/* 
/* 


/* 
7* 
/* 
i= 
/* 
1* 
= 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
Vi 
/* 
/* 
rie: 
is 
Fi 
/* 
/* 
/* 
/* 
/* 
/* 
[= 


'l' or ey! w/O ts! 
RESERVED FOR FUTURE USE 


JM w/O eee 


invalid numeric constanme 
literal w/o ending 


-- bad logicaiia 
'S' w/o proper followingwenae 


“7 
eh 
“7 
"2 
+i 
~y 


unidentified char in input file*7 


out of memory 

error in statement following 
‘sx ! 

error in type definition 
followings sxx) 


unable to complete eval of 
the blockbody 

missing or misplaced ; 
definition 

invalid QualExe 
invalid TypeExp 

bad or missing formals 
missing or misplaced 
missing ID after '‘'TYPE' 
bad definition after AND 
missing or bad AuxDef after 
WHERE 

missing or misplaced '}' 
error in processing 
successive Actuals 


after 


missing literal after keyword 


Pioe 

missing or invalid exp after 
keyword == 

IF statement w/o ENDIF 


error in formals preceding |-> 


missing or invalid QualExp 
following comma op 

error in ArgBinding - check 
OualExp Toma 

off in OZONE-unimplemented 
feature 


“7 
“a 
gh 
a 
gh: 


ae 
a, 
Po 
of 
ates 
7, 
"7 
pis 
ae 
“i 
a 
+7 
<7 
“7 
eh 
“i 
<j 
ees 
nee 
aie 
ais 
<7 
<7 
ee 
a: 
ey 
*/ 


#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 


ERR_S 28 
ERR t 29 
ERR_u 30 
ERR _V at 
ERR wW AZ 
ERR_X aa 
ERR_y 34 
ERR Z 35 
j= NOTE 


/* 
1s 
Yel 
es 
/* 
j* 
/* 
/* 


s through z reserved for future use */ 


[RKKRRKKKKKK KKK KKK KK KKK SEMANTIC ERRORS KKK KKK KK KKK KR KK KKK KK KK KK OK KR OK / 


#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 
#define 


fendif 


ERR_aa 
ERR_bb 
ERRECe 
ERR_dd 
BRnwec 
ERR OEE 
ERR_gg 
ERR_hh 
ERR) 
ERR_jj 
ERR_kk 
ERRiTE 
ERR_mm 


39 
Sa 
35 
a 
fs) 
Bs) 
30 
5 he) 
Bis) 
a0 
EIS: 
So 
30 
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/* 
7 * 
/* 
/* 
/*® 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 


Numeric value expected 
Natural expected 

Integer or natural expected 
Beeorrin Tuple Definition 
Undefined var in "and" sccpe 
Function w/o function def 
Formals mismatch 

Undefined function 

Real Number expected 

Invalid Constant 

Boolean value Expected 
Boolean Operator Expected 
Out of run-time memory space 


Pe 
=/ 
by! 
ee 
ae 6 
af 
my 
aa 
ae 
ats 
Bay 
au 


[RRR RK KK KKK KKK KKK KEK KK KKK KKK KKK KK KKK KE KK KKK KKK KE KKK KK KKK KK KK KK KK KKK KK 


PUBLIC DOMAIN SOFTWARE * 
* * 
* Name : Semantic Definitions Header File * 
* File >: Semcheck.h * 
 AUehors Maj E.J. COLE / Capt J.E. CONREE@ * 
* Started 01/01/87 * 
* Archived : 04/10/87 * 
* Modified : 04/13/87 "FILENAME" eliminated EC * 
Kew KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KK KKK KKK KKK KKK KK 
x This file contains the header file and definitions for the semantic * 


* checker and code generator of the PHI compiler * 
RK KK KK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK 
* Modified 04/13/87 "FILENAME" eliminated; output path now * 


- depends on user's input EC * 
KKK KKK KEK KR KKK KEK KKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK KKK KKK KKK KK / 


[ERK KKKKKKKKKKKKK KKK KKK KKK KK KKK Externals KKK KK KKK RK RK KK KKK KKK KK KKK KKK / 


#include <scanner.h> 
#include <parser.h> 
#include <errors.h> 
#include <stdio.h> 


[RK KKK KKK KKK KK KKKKKK KK KKK KKK KK Globals KKK KK KKK KE KK KKK KKK KK KK KK KKK KK K / 


#define NOTFOUND 0 /* Definition for findvar +7, 

#define UNTYPED 0 /* Type Definitions and sizes =f 

#define BOOLEAN 1 

#define BOL BYTES 2 

#define REAL 2 

#define REAL BYTES 4 

#define INTEGER 3 

#define INT BYTES 2 

#define NATURAL 4 

#detine NAT BYTES 2 

#define ERROR O 

#define MAXADDR 64000 /* Max # of bytes in var space a! 

#define MAXTYPES 300 /* Max # of types in one scope 7 

#define CODE SIZE 20000 /* Max size of code buffer 7 

#define START ADDR 0 /* Starting address for varspace */ 

#define TYPE ENE = 5 /* Pointer to the last initial a 
/* typetable entry 7 

+#define CNTRL_Z 26 /* Control Z ase: et 

#define ENDSTRING O /* String terminator <7 

#define NUM BASE 48 /* Lowest ascii number as 

#define STACKSIZE 10000 /* Increase in stack size “Th 

#define SIZEBUFFER 30000 /* Size of output overex bis 

#define ADD 1 /* Sem check codes for arith Goss 

#define SUB 2 

#define DIVIDE 3 

#define MULT 4 

#define SEM ERR 0 /* Flag to indicate semantic pi 
/* error follows ai: 

#ifndef NULL 


#define NULL O 


#endif 


eee ee eee a ae KAR KK ARK AKER KE AKEAKERERERERKKKK RAE R 


* Rad 
* Tyee. Definicions x 
* * 


HK KKK IK TK KIKI II I IKI IOI IK FR KKK RIO IKI IKI IR RIK KK RK KR KK KR KK Ke / 


typedef int optype, /* Arithmetic operations ef 
FLAG, /* Generic flag type ae 
PHITYPE; /* Types found in language ay 
typedef char stg [20]; /* Assembly language code names oir 
typedef struct and struct *and_ ptr; /* Pointer to and table entries od 


TRRERKKKEKKKKKKKKKKKKKEKEKEKKK Typetable Detinitions kK KK KKK KR KK KR KK / 


typedef struct typenode { /* Typetable entries af 
char name [10]; 
int bytes; 
Struct typenode *typeptr; 
} tnode; 


[RK KK KK KK KKK KK KK KKK KKK KK Formallist Befinitilons HK KK KKK II / 


typedef struct formnode { /* Formal stack = 
int name, type; /* formname, formtype a A 
Struct formnode *link; J *7Eink fOreisise x / 
} fnode; 
[RK IK IK III I kk Vartable Definitions KKK KK KK KKK RK KK KK KK RK / 
typedef struct varnode { /* Entry for variable stack = 
int type, /* varname, vartype i | 
forum, Vree tag Seb Tf) var. 1s amrormal = 
def; fo Prue tLin var 1S a Gefinition ays 
nodal nptr- (= per. co cetining node He 
Enode ,* fptr; J/* ptr to formals Sys 
SErUCU Varnoge *link; y Pepe kek or ast ee 


Pei VarDer 


[RK KKK KKK KR KK KK KK KK KK & Deftable Definitions RK KKK IKK tk ke / 
typedef struct defnode { 
int type; /* varname, vartype ey 
nodal nptr; [= peEreto Gcefining node tf 
Enode * fpr; {<spur CO. CoOrmals */ 
Struct defnode *link; P= pike tor List ay: 
PP ~Gerptr; 


[RRR KKK KEKE KKK KKK KKK KKK KKK KK And HDeafinitions KKK KKK KKK KKK KR KK I KK / 


meeuet and struct /Soenueture tor and lists od 
(nodale per; j-ePtr co nodal containing var name 

a 
iiiees Out LOC; /* Ptr to buffer where = 
/* name is called nas 
Semuectrand struct *link; js iinky tor Linked list / 


i 
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[RRR KKKKKKKKKKEKKKKKKKKEKKKKKKKKKKKKKK RK KX KK A ERS RR 


* PUBLIC DOMAIN SOFTWARE x 
® x 
* Name > User Header x 
x File * , useren x 
* Authors : Maj E.J. COLE / Capt JE V some * 
* Started 2. (04770 87 x 
* Archived : 04710/87 * 
* Modified : x 


Kw KK KKK KKK KKK KK KKK KKK RK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 


* This file is the header file for the user interface mocule * 
x (user.c) Be 
eeu KKK KK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKeKeKK 
x Modified : * 


RK KK KK KR KKK KKK KKK KK KK KKK KK KKK RK IK KKK KK KKK KK KK KKK KKK KKK KKK KK KK KK KKK KKK / 


[KKK RKKKKKKKKKKKKK KKK KKK KKK KK KK Globals KKK KKK KKK KK KKK KKK KK KK KK KK KK KKK / 


#define BUFFLENGTH 30 /* Max size of input file name + */ 
/* directory */ 

#define NOTFOUND 0 

#define BSIZE 1000 /* Input buffer size */ 

#aefine BLOCKSIZE 50 /* Input Blockesace «/ 

#define BACKSPACE 8 /* ASCIl Equtveatentes de 

#define EOLN 13 

#define ESCAPE 27 

#define GETPROGRAM “Program to Compile -> " /* Messages to observer «2 

#define HEADER] “ROCK COMPILER" 

#define HEADER2 “Press Escape Key to Exit Compiler" 

gcetine PEER ERROR File neu Found” 

#define FILE2 ERROR “Press ESCAPE to exit, any other key to continue" 

#define WAIT “Compiling: Please Wait" 

#define PAUSE “PRESS ANY KEY TO CONTINUE" 

#define ERRORFILE “errors.phi" /* Textfile of errors a” 
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APPENDIX F 
ROCK COMPILER — MAIN MODULE 


Re eee eee ee ee OC rn ARK KARA KKK KARARKAKAARKAKKAKKKKKKE 


x PUBLIC DOMAIN SOFTWARE x 
* x 
* Name : Main Rock Module * 
— File we ioeck Main.c “ 
* Authors Serial J. COLBe, (apts d.E. CONNELL x 
* Started > 009/06/87 x 
* Archived : 04/10/87 x 
peroditied : 04/13/87 Output files put to vdisk EC * 
KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK 
* This file contains the following modules for the PHI compiler: =: 
* *« 
= Rete etal Semcheck Main ‘ 
* * 
Sea lgorithm x 
* This contains the main procedure for the phi compiler, in add- * 
Sereion to Ehe initialization procedure & the main semantic checking * 
* procedure. The main module inits the program, sets up the screen * 
* by calling “user ()", & decides whether an error routine needs * 
* to be called. It also closes out the input file. * 
. The “semcheck procedure is designed to be called by any function * 
* with a ptr to a parse tree node as an argument. It will then * 
* determine which sub-module is necessary to check the node. * 
* "Reimitial” presently has the function of initializing the type * 
* table. a 
* * 
KEKE KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK 
memoditied ; 04/13/87 Output files written to vdisk, "d:" EC * 
KKK KK KKK KK IK KK KK KKK KK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KK KKK KKK KK / 


[KKK KKK KKK KR KKK KKK KK KKK KK Externals KKK KKK KKK KKK KKK KKK KKK KK KKK KK KK / 


#include <semcheck.h> 


Beeern void c startup (), 7* Cnrtialuzer Ler codes buffer nee 8 
c ending (), /* Close out for code generator = 
user (), /* User interface ok 
Meernere 1), /*~ EGEOY Writing, interface */ 
peclose. (), /* Close source file =/ 
set page (), /* Change video display page ay 
mov_cursor (); /* Move cursor to specified locat */ 


eeeeern FLAG err found; 
extern nodal parser (); 


[RK KKK KKK KK KKK KKK KK RK KK KK KKK Globals KKKKKKKKKK KKK KKK KKK KKK KKK KR KR KKK / 


unsigned _stack = STACKSIZE; 
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[RRR KKKKKKKKKKKKKK KK KKK KKK R Tinie war KKK KK KKK KKK KKK KK KK RK KK KKK / 


void 
Vein oral xi) /* Initialize semantic checking 
{extern tnode types []; 

strepy (types [UNTYPED].name, “untyped") ; /* Set up type table 


types [UNTYPED] .bytes = NULL; 

strepy (types [BOOLEAN] .name, "boolean"); 
types [BOOLEAN] .bytes = BOL BYTES; 

Strcpy (types [REAL].name, “real"); 

types (KEAL].5ytGs.— Rea ee tes. 

strepy (types [INTEGER] .name, “integer"); 
types (INTEGER) byCes. FN eb elno: 

strepy (types [NATURAL] .name, "natural"); 
types [NATURAL] .bytes = NAT BYTES; 





[RRR KKK KKK KKK KK RK KR Rk SemChecker KKK KK KK KKK KK KK KK KK RK RK RK KK / 


PHITYPE 

semcheck (ptr) /* Breaks Sem Check into Gases 
nedal ptr; 

(extern. PHITYPE tkhinder OF Cecarraw ():, 

tfunid (), tid (), tconstant (), tactuallist ()> tactua women 


PHITYPE type; 


switch (ptr->name) ( 


case (ADD ) 
Gase (SUB 
case (MULT) 
ease (kDIV )) 


Casey tly i) 

case (COLON) 

GCasie (GATE) 2atyrece 
break; 

case (POS) 

case (Niel > GCype 
break; 

Case (OREOS 2°) (LYpe —=-tor (pcr), 
break; 

case (ANDLOG ) : type = tand (ptr); 
break; 

case (NEGLOG ) : type = tnegation (ptr); 
break; 

case (KINDEF) : tkindef (ptr); 
break; 

Case ARTARKOW Je. :> CYDG*=<CrCarrow, (Per )7, 
break; 

Case (LETDEF) +: tletdef (ptr); 
break; 

case, -(hwe ) WHERE 3. Cype. = Cwhere (ptr), 
break; 

case (AUXAND) : tauxand (ptr); 
break; 

case (DATAAUXDEF) : tdatauxdef (ptr); 
break; 

case (FUNAUXDEF) : type = tfunauxdef (ptr); 
break; 

case (FUNID) : type = tfunid (ptr); 
breax; 

case (ACTUALLIST) : type = tactuals (ptr); 
break; 

case (COMMA) 


arleEnopo (per): 


tprimary (ptr); 
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x / 


“7 


“a 


case (ELLIST) felist.(ptrin, 
break; 
case (TYPETIMES) type = ttypetimes (ptr); 
break; 
case (EQ) 
case (LEQ ) 
case (NEQ ) 
case (GEQ ) : 
case (KW_ + GREATER_) 
Gase (kW > + LESS} 
Case seni pe NE)) 
case (Awa) + NOTIN) type = tcomp (ptr); 
break; 
ease. (AW + IF ) type = £1f (pte); 
break; 
case (KW + ELSE ) type = telse (ptr); 
break; 
ease (KW + THEN) Ey Pema cencm: (plr), 
break; 
case (KW + ELSIF _) type = telseif (ptr); 
break; 
case (IDENTIFIER _) type = tid (ptr); 
break; 
ease (CONSTANT) type = tconstant (ptr); 
break; 
case (REAL ) type = REAL; 
break; 
case (INTEGER ) type = INTEGER; 
break; 
case (BOOLEAN ) type = BOOLEAN; 
break; 
case (NATURAL_) type = NATURAL; 
break; 
default EGrrOr (ERRUE, per-oin): 
break; 
return (type); 


/* 
/* 


Unimplemented feature found, 
so sandbag programmer 


tg 
ay 


[RKKKKKKKKKKKKK KKK KKK KKK KK KKK KKK Main KK KKK KKK KKK KK KKK KKK KE KKK KKK KK KKK / 


main () 


{extern char prefix []; 


extern void curson (), 


Cursore ()s 


Gwar name holder [30]; 
MOocaal root; 
Eescartup ()- 
mermitial (); 
wmser (); 
if (root = parser ()) { 
set_page (2); 
CUrSOLf ().4 
semchneck (root) ; 
Pee Ciexr found) { 


G ending {); 
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= 
/* 
/* 
/* 


/* 


/* 
/* 
/* 
/* 


pix 


= 


Prefix of the souce file 
Tucwecurser On and OLF 
Holder for prefix name 
Root of the Parse tree 


Initialize and open files 


User interface 


Parse code; continue if root 


not equal to nil 
Freeze current video display 


Semantic check and code gen 


Clean up and close out files 


es 
ws 
wh 
ait f 


si 4 


aes 


forkl ("d:rasm86.exe", "“d?rasmeG exe /* Assemble the code xf 
prefix, NULL); 

forkl (“d:link86,.exe", “d:linkse,exe /* Link object files together =7 
- Orelix,.", "Ua bean LL) e 


strcpy (name_holder, prefix); 

strcat (name_holder, ".1lst"); /* clean up the loose fiiee “7 
remove (name_holder); 

strcepy (name_holder, prefix); 

streat (name: holder Sym. 

remove (name_holder); 

set page (0); 

CUrSOn TO, 


} } 


if (err found Wl) irooce) a4 /* Print error files Tiga 7 
set_page (0); 
CUuUrSOnN =); 
user_err (); 


} 


Pp closet); /* Close source file “i 
execl ("rock.exe", "rock.exe", NULL); /* Execute rock again; exit comes */ 
/* from inside main Procedure “7 


70 





APPENDIX G 
ROCK COMPILER — SCANNER 


ee eee ae a ee ee eee en OX OR ARR K RK ARK R RE RR KARR KRK RAE KKK KKK KKKK 


x PUBLIC DOMAIN SOFTWARE = 
x Name : Scanner * 
* File : Scan2d.c e 
enue hnors ; Manmeedemeoue / Capt J.B. CONNELL * 
* Started : 10/10/86 * 
* Archived =: 12/11/86 x 
meModified : 04/23/87 tokens no longer output to intermediate file. * 
Kae KK KKK KKK KKK KK KKK KKK KKK KKK KKK KK KK KKK KK KKK KEK KKK KKK KKK KKK KKK KKK KKK KK KKK 
* This file contains the execution modules for the scanner: * 
* * 
* GetToken(), IsKeyWord() x 
* x 
* Algorithm : GetToken is called from FillBuffer() and returns an * 
* integer code to uniquely identify the token. : 
: IsKeyWord() checks each identifier to insure it's not . 
. a PHI KeyWord. : 
Kw KKK KKK KKK KKK KKK KKK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 
* Modified : 01/10/87 Corrections to comply with latest definitions * 
* Oe tene- language. JC x 
‘s 01/10/87 GetToken() returns CONSTANT _ vice REAL_ or - 
* INTEGER_. JC * 
* 01/21/87 Error Recovery added and files combined. JC . 
* Os) 07 co eoOrrect tomo ewee yoartially comply with latest : 
: definitions of the language. JC * 
. 04/23/87 tokens no longer output to intermediate file * 
: GetToken called directly by the Parser now. - 
eK KK I I KKK I I III II I I I IKI IK IK I IO IO I KO / 


#include <scanner.h> 
mrmclude <stdio.h> 
#include <errors.h> 
#include <ctype.h> 


extern PILE *i nitrile, .*errorfiles i =WOrkKsng tiles aT | 
[KK KK I III I I I I I I IIIT III III TORII III III I I IO II I IO I / 


iene 
GetToken (token) 
Grar *token;: 


fecal ls fgetc(infile) for the next char from the input file & builds * 


Beecne token a char at a time. Returns an internal integer value 
* representing the type of token found “ns 
{ 

/* ,loekanead is a flag, line num */ 
Static int lookahead = FALSE, line num = 1; (oO Siseeciercenrt line *£ of user prog */ 


7 


Stat le char cn. 
ine a 
extern ErrorHandler ts. 


while (TRUE) 
(" i= 


if (!lookahead) 
cn = foetelintite): 
lookahead = FALSE; 


while (isspace(ch) ) 
{ if (eh == “\n") 
{ ++line num; 
PecuLnAtEOEN a): 
) 


ch==foere (ira rei. 


if (ch == EOF ) FreCuga EOr a, 
switch (ch) 
{ case '+': Feecurn(ADD: ); 


Case um -. PecCcucn (MULT. 2) 7 


/* ch holds last character ize 
/* Inputweeeg 

/* 1 = index into token array; 
/* k = temp holder for tokens 


token name -- 
at token( 


7 * einitialrze: 
/* will stare 


/* process carrage returns 


/* @ndeit  °vne 
/* end while white space 


/* reached end of the Eile 


>) 


Gase -'%*; PeCUCA( ULV.) 
case ‘;': PECuEn (SEM leg 
case's recurcnt( SUBSCRIPT -); 
case % ': Fecurn (COMMA, ); 
case '('; return(LTPAREN ); 
Case e)-.. recCurn«nKIPAREND); 
case, ' =) EEECUrAINEGLOG)); 
case 83's return(COLON ); 
case '*': retina eat), 
case ‘'@': FELUGN tS TART )s; 
case '['; Eetucn (hPeRAKe Te), 
Gases. FeECuEm RI BRAKES 
case ‘{'; return(LTSQUIG ); 
case *}™: return(RTSQUIG ); 
case =e 

if ((ch = fgetc(infile)) == 

return (RTARROW ); 


else if(ch == '-') 
{ while((ch = 


b= PAR ees one! 


VECCh == Vn) 
(- ¢-linesnum: 
return(EOLN ); 

)> “else -Frecurn (EOF 2); 
) 
else 

lookahead = 
return (oUB:.)¢ 


Louk; 


case '<'; 
if((ch = fgetc(infile)) == 
return(LEQ ); 
else if(ch == '>') 
return (NEQ.); 


else lookahead = TRUE; 


/* process comment 


fgetc(infile) ) 
EOF) 


/* do nothing 


/* end else if comment 


a 
7 


a 


°F 


<7 


bi 


7 


aly 


<7 


return(ST SEQUENCE ); 


case '>'; 
Peiteh = fgetc(infile) ) 
Ber wen (GEO), 
else lookahead = TRUE; 
return(END SEQUENCE ); 


case ‘=': 
Pe (tene— fFgete(infile)) == '=") 
return(EQUIV ); 
else looxahead = TRUE; 
retuLrl(EO )-; 


case '/ : 
Pe (Che foetc (inti le) ) 
return(ANDLOG ); 
else lookahead = TRUE; 
BeCCULEMIGRDLYV =) 3 


Gase XN" 
PEC (Ch = foetc(infile)) == 
return(ORLOG ); 
else 
lookahead = TRUE; 
ErrorHandler (line num, ERR2,NULL); 
return(ORLOG ); yee 
case. ate 
Pe4teh = fgetc(infile)) == 
brvich ="tgetc(intile)) 
Berle Gg hINE RT ARROW ).; 
lookahead = TRUE; 
ErrorHandler (line num,ERRO,ch); fs 
return (LINERTARROW ); ie 


==> 


case 
ch = fgetc(infile); 
Le oe ose ae 
GEC Urn KEAL 
else if ((c PR 
retuen(NATURAL }; 
else if ((ch == 'Z') [| 
return(INTEGER ); 
else if ((c sie iba 
return (BOOLEAN ); 
else if (ch == '1') 
Geturat TREY PAL.) 7 
else lockahead = TRUE; 
ErrorHandler(line num, ERR3,NULL); 


== Cehe ==7 ey) 


S= Ce —— Ma) 


(eh == *25)) 


== (ch == 'b')) 


EFCturaA (INTEGER );+ ys 
} {= 
me ( i salphatch)) as 
| axelel 
{ token(i++] = ch; 
elm=— foetc(infile) ; 
} while (isalnum(ch) || ch ==' '‘); i= 
tokenpa) = "\0"%> ae! 
lookahead = TRUE; 
/* 
/* 
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figured that's what he wanted 


athe 


ch is either oper dae 
figured that's what he wanted 


default return type 
end switch 


Soares (wltna Letter 


end do 

end the string 
nOwMecnNecx tO See 1f 1's a 
KEYWORD 


af 


1f(( k = IsKeyWord(token +1)) >= 0) 
PeEUrN ( KWo na, /* Return Adjusted Keyword index +*/ 
/* to calling aroreune x/ 
recurn (EDEN ERE ER oye, 


} /* end 1fVaeta cnar «/ 
if (isdigie (en) 
{) 2Etene=— 103) 
{ while((ch=fgetc(infile)) == '0O') 
; /* do nothing, eat Zeres =a 
LE! isduaqre (en) 
token (i++ ]° = "oO"? 
} /* end if leading 0 «/ 
while (isdigit4en)) 
{ token{i++] = ch; 
ch = fgetc(infile) ; 
) /* end while is a digi ly 
Lf {cha -e 
{ token[i++]-="ch:; 
eh =" foetre (inti te); 
if asdigiecen)) 
{ token (ajy— seo > 
ErrorHandler(line_num,ERR4, 
token+1) ; 
token[i + 1] = token[i]; /* fix for insertion singe <7, 
token(i] = 0; /* name table x / 
return (CONSTANT ); 
}else /* end if Nota digas. »/ 
do 
{ token[{it+]) = ch; 
ch = fgetc(infile); 
) Viwhitetesdia? tilenje): /* end do <7 
} /* end if chr ==s2— iy’ 
token[{i] = '\O'; /* end the string =/f 
lookahead = TRUE; 
return(CONSTANT ); 
} /* end- if isdieuc ae! 
if [en ==" \"") /* process LITERALS ce 
{ token[{it++] = ch; 
while(((ch=fgetc(infile))!=EOF) «6 
(ch!i="\n") €& (1< MAXLINE) ) 
{ token[i++] = ch; 
5 ie (c == es) 
LE “(eh = foete(intile))  !=2 yy) 
{ lookahead = TRUE; 
feken ti) = "No": 
if (strlen (token) > 3) 
Feturo, (LITERAL); 
return (EMPT LIT ); 
} /* end if != 7 
} /* end while bi 
token [1] =*\0-- /* end the Vvstrings eo! 
ErrorHandler (line _num, ERR5,tokentl) ; 
return (LITERAL ); /* figured that's wnat he wanted */ 
} /* end if dite. a: 
ErrorHandler(line_num, ERR6, &ch) ; /* Default - char not recognizeduae 
continue; /* let's try again <7, 
/* end while (true) <7 
/* end GetToken() 7 
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[KK I I IK Scanner Utilites TO II I / 


one 
IsKeyWord(token) 
char “token; 


/* Checks to see if the input token is a keyword in the language. * 
* If it is, the function returns the numeric value of the keyword. o 
Zoif tt ism ep the Luncerem returns -l. Performs binary search of * 
x keyword array - * 
* MUST KEEP THIS ARRAY IN ALPHABETICAL ORDER!! x / 
{ 

int iy 

register int Pomme Ni. mid: 


/* list of PHI keywords - KEEP in */ 
/*eaichabet ical order! ais 
char s(MAXLINE) ?stacic char *keywords([(] = 
Sel iOe ee BEGuNe  Baok -,  Sbolk "END, “ENDIE") “FP ELE", "GREATER", "LE", 
he eer bee NGI No eRe AD “THEN iY PE "WHERE", "WRITE". }; 


SeErcpy(s, token); 


for(i = 0; s{i} != '\O';i++) 
MeGedee<= S{/ij| && sii} <= 'z") /* insure letters are upper case */ 
S (2) a ee eee"; 
hi = (sizeof (keywords) /sizeof (char*)); 


while(lo <= hi) 


eed = {los hi)/2; 
if((l = stremp(s, keywords [mid] )) <0) 
hi = =—mid; 
else if (i>0) 
lo = ++mid; 
else 
return(mid); /* found a keyword a7. 
} /* end while «/ 
mecurn(—1) ; /* didn’t find a Keyword <7 
a /* end IsKeyWord =/ 


[RIK I IK II IKI III I III III I I I I I ke / 


aS 


APPENDIX H 
ROCK COMPILER — PARSER 


[OK IK I IK KI KKK IKK III IF IE II FIR FIA I RII I KI I II II II ek 


= PUBLIC DOMAIN SOFTWARE 

x Name : parser pt <1 

* File : Parserl.c 

* Authors : Maj E.d. COLE / Capt JE -2eceieEere 

x Started : Oy 20766 

* Archived : E27 186 

* Modified : 04/23/87 No longer set up to work with file of tokens. 

KKK KKKK KKK KKK KKK KK KKK Kk kkk Kk kkk kk KKK kkk kkk Kk ka Keke Kk KK KKK Kk kkk Kk Keke Khe K KKK KKK KK KK 

* This file contains the following modules for the PHI parser: 

x 

* BlockBody () Berbers) Defs () DefAnd () QualExp () 

x AuxExp () AuxDefs () AuxAnd () Formals () Expression () 

Algorithm : The main module calls BlockBody() to start the parse 

off. BlockBody in turn calls LetDefs() first andweged 
QualExp() looking for a valig@progean- The remaining 


validate a pargram. 


ef the language. JC 


*#include <stdio.h> 
#include <parser.h> 


Eat rtbrket FALSE, argbind = FALSE; 


ile 


aay 
ble pyc Line no 
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to build the tree and 


modules in Pt's 1-3 are called by these when trying to 
The results from the parse are now 
kept in an abstract syntax tree for type checking and 
code generation. Various utility functions are used 
Simplify parsing the grammer. 


Kae KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK Ka KKK KKK KKK KKK KKK KKK KK 


Modified >: 12/26/86 Flattened tree output changed to abstract 
Syntax tree form. JC 
01/10/87 Corrections to comply with latest deftinwtaea. 


01/27/87 Error Recovery added and files combined. JC 
03/20/87 Token buffer implemented for parser. JC 
03/29/87 Changed manner errors are handled — required 
for integration with back-end. 

04/23/87 No longer set up to work with file of tokens. 
GetToken is called directly thru FillBuff(). JC 


Ke KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK 


/* 
/* 


/* 
/* 
/* 
/* 
/* 


a a a a a a a a a a a a a a ae a ae ce ae SC, SC, SC. GC, Sic, Outs SCs 


global flags - aid in makiag 7 
PHI deterministic "7 
global var, current line no «7 
of program ee 
tokenbuff holds tokens provided*/ 
by GetToken() - ptr is a4 DoReGaae 
next token in tokenbuffer - a 


/* must use "long" because buffer */ 
/* holds addresses = / 
/* use BUFSIZE + 1 in case have to*/ 
/* place address of *name at end */ 
Votre butter _ 


long tokenbuff[BUFSIZE+1], *ptr = &tokenbuff[BUFSIZE]; 
ELLE ‘ooutrile, “errorfile; /* working files «/ 


ROE Rs eer an A ee KK ARR A AERA RRR AKA KARA KK KK EK KKK / 


nodal 
Parser () 


{ 
NodeRec “root. — NULL; 


extern Voldwewelose(), mov_cursor(); /* external asm functions ae 
num errors = 0; /* init number jof errors ai 
Smmortivte = fopen("errors.phi"™, “w"') ; 
momine, (ernorelle,"*40s\n\n", "ROCKY ERRORS") ; 
fclose(errorfile) ; /* rewrite file for clean start my 


#ifdef DEBUG 


poutfile = fopen("parser.out", "w"); 
#tendif 
BlockBody (&root) ; /* look for a valid program a 6 


if(!ByPass (EOF _)) 
Geemovy cursor (20,0) 7 /* set cursor on screen to i 
printf("WARNING ...additional text found /* found extra junk, tell user a 
at completion of your program - 
Ene scan, ne one) ; 


} / end wt not end: Of iser's prog: -*/ 
#ifdef DEBUG 
te root != NULL) /* write parser's output i 
/* to data file ig 
PostOrder(roct); /* case it's needed for debugging */ 
Meri nee teout file, "\n"); /* need that carrage return ay 
fclose(poutfile) ; 
#tendif 


melose (infile) ; 
peelose(); 


mE (ntim errors > Q) 
return (NULL) ; 
else 
BOtiEn (bOOL) 


} , Send main eos 
[RK wR KR KR RK KI IK I I IO IO IO II IK OK KR KK RR RK / 


“enue 
PostOrder (root) 

NodeRec TiO Ge, 
Jog Does a post order walk of the tree with (root) as its head. saa 
‘og Just prints out the node name to the screen now ys 


{ 


7 


Static int i = 0; /* used in pretty printing parser */ 
/* CUCPUE eee <7 
if (root != NULL) 
{ POStOrdem(reoce—e DEE), 
PostOrder(roct =>rptr); 


switch (root->name) 
{ case IDENTIFIERS 
case CONSTANTS 
Case EP EERAUs 
{ fprinti(poutrtite, ta“, rect —-name)r, 
fPrinth(peucrlte, “sla " root->index) ; 
break; } /* end ID, CONSTANT, LITERas a 
default : 
print i (pevemile. ta *, FrOCU.- name) 
} /* enG@ switen = 
LE (0 (++L % 7) ==0)0) teeinte (pout file, ne 
} /* end root != NULL ay 


} /* end PostOrder() « / 
[RRR RK KKK KR KK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KK KK KK KK KK KK KK / 


int 
Block Body (root) /* root is a ptr to tree/subtree */ 
NodeRec <7 TOOu. /* currently working with “7 
| Bs <BLOCKSODY> ::= <QUALEXP> | <LETBEPs-= «f/f 
{ 
Gri Elag; 
if(((flag = LetDefs(root)) == TRUE) ) 


return (TRUE); 
/* looking for LETDEFS; BLOCKBGa yam 
else if(flag != ERROR ) /* lock for plain ol QUAD iy 
Elag = QualExpi26o0t): 


return (flac); 
} 
[KI III IRI KI III II III III III III OK IKK KIO II I I / 


Bee 
LetDefs (root) /* root is a ptr to tree/subtree es 
NedeRec baad sexe 1 Ea /* currently working wise “7 
ees <LETDEFS> ::= let <DEFS> ; <BLOCKBODY> *y 
{ 
#ifdef DEBUG 
Printf(" letdefs entered\n"); Scant ts *c'): 
tendif 
12 (ByPass (KW + LET =)} /* starts Off wich ben “7 
{ *root = CreateNode(LETDEF); /* start eft senemerce =f 
if (DETS(6({* root) —>lptr))  '= TRUE) /* look for the definite. 7 
Errorrandler(11ne ine, Bk vd, /* reperEe tity sepy =: Eis “7 


(Tong) SEM Ie); 


LE BYP ass (SEMI )) 
ErrorHandler (line _no,ERR_b, /* report it & try to GOnme ee “7 
(long)SEMI_); 
BYPass (SEMEN) 


if ((BlockBody (&((*root)->rptr)) == TRUE) ) 
return (TRUE, /* found everything bay 
ErrorHandler (line _no,ERR_a,NULL); /* Y@POre 1c, aie ee ux “7 
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} 


return(ERROR ); Pr Started LELTDEFS SUE cetldn't 
f= finish 
/* end ByPass LET 


#ifdef DEBUG 


Bugtti. letdefs exited\n"); Scant ("S* Cc"); 
tendif 
return (FALSE); 7* default = no LET at beginning 


} 


eee eeeeerereta 7 © X ranean x XX XX ARK RNR KAA R AR ARK RR KE KK REXKKKRERR AKER KEKKKK KK 


/* end LetDefs 


ant 
Defs (root) /=~SOOt is a ptr to itreé/subt ree 
NoaeRec ~sEOOte 7 = CULEene ly working with 
/* <DEFS> ::= (<DATADEF>|<FUNDEF>|<KINDEF>|<TDEFID> | 
/* <TDEFFUN>) <DEFAND> 
/* Where "<DEFAND> " need not be present. 
{ 
Noderec *temp; 
mat flag; 
long aks io) Sy ae /*eaddress of data struct 
/* holding identifier name 
extern tong “pt ry 
PE(id ptr = ByPass (IDENTIFIER )) 
{ temp = CreateNode (IDENTIFIER ); /* set up itsside of subtree 
temp ->index = id ptr; 
Be(ByPass (EQUIV )) /*“Looking for. IDs== 
{ *root = CreateNode (DATADEF) ; /* found ‘==' It's a DATADEF 
(22 Oct) —>1pts.= cemp; ( sateach EeMp PrEr to root 
mrvOualExXp( 6 (-coot)—>rptr))) {= TRUE) /* now need QualExp 


}*wnere, try & fix 
ErrorHandler (line _no,ERR c, 
(long) KW_+AND_); 


} /* end ByPass EQUIV_ 
else if (ByPass (COLON _)) ,iaokiung For @D = TYPEEXP 
{ *root = CreateNode(KINDEF) ; (amEeunc S610" Ss. .da KINDEF 
(*root) ->lptr = temp; /* attach temp ptr to root 
if ((TypeExp(&((*root) ->rptr))!= TRUE) ) /* now need TypeExp 


/tomote,try to fix 
Errertandler({line no,ERR d, 
(long) KW_+AND_); 
/* end else if ByPass 
else 7* not == or :, so must be 
/* ID FORMALS 
{ ‘*root = CreateNode(FUNDEF) ; 


(*root) ->lptr = CreateNode(FUNID); {/* will look for ID FORMALS 
(=roO6u)) ->lper->lptr = temp; pT Rote aehwibe vo. FUNTD 
L£( (Formals (&(* root) ->lptr->rptr) 
!=TRUE) ) /* need the FORMALS 
ErrorHandler (line no,ERR_e, peice alk, Gay «&.-L ix 
(Fong EQUIV); 

/* Look for ‘==',already created 

Pe ByPass(EOUIV )) /* FUNAUXDEF - Need QualExp on rt 


7* noece, try & f£1x 
Epuoutandler (lune no, ERR f, 
(long) KW_+AND_); 
else if ((QualExp(é ((*root)->rptr) ) 
!=TRUE) ) 


Thy 


aed 
es 


ef 
my 
asf 


ay 
Ber 


af 
mh 
a | 


ot 
oy: 


os 


ie 
wes 
pas 
ay 


ok 


uae 
aad 
a 
ef 
sis 
ae 


ad 
i 
ee 


i 
ef 


i 
ts 


wa 
hf 
ay 


ErrorHandler (linetne, Eakue, 
(long) KW_+AND ); 
} 


goto CHECK; 


[xRxKKKK 


Cudm tt find 1D, "scorlook to-= 


else if (((flaq = ermal siitcory) 4 — SALSER) 
{ if(flag==ERROR_) 
ErrorHandler(line no,ERR e, 
(Tong) EQULVS); 
if (ByPass (EQUIV®)) 
( MakeNewRoot (root, DATADEF, LEFT); 
if ((QualExp(é ((* root) ->rptr)) !=TRUE) ) 


ErrorHandler(line_no,ERR_c, 
(long) KW_+AND_); 
jelse 


ErrorHandler(line no,ERR f, 
(long) KW_+AND ); 


goto CHECK; (ee 
/* 

} 
Tae oie! nothing so far = look for Some 


else if (ByPass(KW_ + TYPE )) 
( Lite [our = (byeass (POENTIP IER) } 
( C6mip-— Greavenode IUENTIPIERS) 
temp ->index = id ptr; 


if (ByPass(EQUIV_)) 
{ ‘*root = CreateNode (TDEFID) ; 
(=200t)-Slptr = temp, 
}else 
(4 PLE Permals (root) t= TRUE) ) 
ErrorHandler(line_no,ERR e, 
(long) BOULY =); 
MakeNewRoot (root, FUNID, RIGHT) ; 
CrOou me loc re — cenp: 
if (!ByPass (EQUIV )) 
ErrorHandler (line _no,ERR_f, 
(long) KW_+AND ); 
MakeNewRoot (root, TDEFFUN, LEFT) ; 
} 
if( (TypeExpi(s ((* root) —>rptrije = I RUE 


ErrorHandler(line_no,ERR_d, 
(long) KW_+AND ); 
' 
else 
ErrorHandler(line_no,ERR gq, 
(long) KW_+AND ); 
Goto (CHECK: 


return(flag); 
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/* 
/* 
/* 


/* 
/* 


FORMALS 


/* 


/* 


/* 
/* 
/* 
/* 


7* 
75 


/* 
/* 


/* 
/* 


/* 
pia: 


/* 
/* 
P hia 


/* 
(= 
{= 
yf 


/* 
/* 


/* 
/* 
/* 


/* 


note 1t,trym@ewrix 


end else not “==" or... 
found something so need to 
check for more 
end if ID 

== QUALEXP 


aK KKK / 


found something 


note, try & fux 


looking for == 
found so fix tree 
need QualExp on rt 
note, try & £irx 


end if ByPass (EQUIV) 
note, Cry “fa ea~ 


found somenthig so cheeck@ian 
more defs 


Sort of TYPEDEF 


found TYPE, looking Ecumae 
set up lt side of subtree 


LG) D} 


looking for == 
so it's a TEER 


gels 
note Tt try Comeau 


found/fixed Formals, fix tree 
attach ID to FUNID node 
note it, try =omeex 


found/ fixed 
end else not 
need TypeExp on rt 
note, try “§ fix 


end if ByPass ID 
no ID,note it,try Gomes 


found sometthing so checx for 
more defs 
end ByPass TYPE 


default - none of the above 


kK KK / 


“7 


a 


“7 
7 


7 


“7 


“7 
“7 
*7 
"7 


ai 
<7 


*7 
br’ 


“7 
“7 


“7 
"7 


7 
“7 


“7 
“a 
“a 


a 
“7 
“7 
bi’ 


"7 
“a 


“7 
“2 
7 


“7% 


Gah: /* found something so need to x / 


7  CNECKREGOr more det"s . 
Haran. ooc ): 
Pet emi Une). /* any errors nave been notea, =/ 
/* so press on = / 
} /* end Defs x / 


rf 


[RRR KEK KK KKK KKK KKK KK EKA KKK KKKKKEKKKKK KK KKK KKEKRKKKKEKK KKK KKK KKK KR KK RK RK / 


Vera 

DefAnd(root) /POOE, 1S d= per FO .eree/ subtree */ 
NodeRec =~ TOOur /* currently working with 7 

/* Se EEAND>) :;— and <DEFS> x / 

/* Where " and <DEFS> " need not be present. wi 

/* Note: This function assumes root is not NULL upon entry iy) 


{ 
if (ByPass(KW_ + AND _)) 


{ MakeNewRoot (root, DEFAND, LEFT); 7/2 fCunde ano. ?-so fix tree 7 
Mme oetsis (* root) =>rptr) != TRUE) 
ErrorHandler(line_no,ERR_h, 
Cleng) SEMI jy; j Nece 16, try eo: fix as 
} /* end ByPass AND x / 
} /* end DefAnd cae 


[RR KKKKKKKKKKKKKKKKKKEKKKKKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KK KKK KK KK KK KK / 


ae 
QualExp (root) /* root is a ptr to tree/subtree */ 
NodeRec == TOOt ; ; Veurrenely working, with if 
/* <QUALEXP> ::= <EXPRESSION> where <AUXEXP> ma 
/* Where "where <AUXEXP>" need not be present. x7 
{ 
eat E lag; 
#ifdef DEBUG 
orintf(" qualexp entered\n"); scant ("s* ey 
#endif 
i1f(((flag = Expression (root))== ERROR _)) /* errors already reported, ey 
EatEm(KW_+END ); /~ attempt to press on iy | 
if (ByPass (KW_+ WHERE )) /* looking for where expression =7. 
fee ick eCNeGWROOt (root, (KW_+WHERE ), RIGHT); /* found one, fix tree aa 
AUXEwD(G . (* root) =—>iptr)); /* need AuxExp following WHERE a 
} /* end byPass WHERE = / 


#ifdef DEBUG 

printf£(" qualexp exited s0\0",f£1lag) +? 
ceant ("s*c"™) ; 

tendif 


mecurn(fiag) ; ye default =- Just return Elag =] 
} /* end Qualexp() ee 
[RR KK IK IKK I IK IK IO IO IK II TO IO IK III IT TOK III I IO KK I IK I / 


At 
auxexp (root) (2=6ECoe LS) a P&L to tree/subtree —*/ 
NodeRec Oot, (= Seir rently working With it 
/* <AUXEXP> ::= <AUXDEFS> (where <AUXEXP>) * 9 | 
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{ 
cbrete 


LE Ot 2a 


Elag: 


AuxDefs (root) ) != TRUE) ) 
ErrorHandler (line no,ERR_1l, 
(long) KW _+WHERE ); 


if (ByPass (KW_+ WHERE )) 
{ 


MakeNewRoot(roct, (AN) WHERES) RIGHT 
AUXEXp (S (C* rooG) —>1 cer) ir: 


returnlelag); 


} 


/* need at least one AUXDEF 
/* note, try emer 


/* looking for multiple WHERE's 
/* found one, fix tree 

/* need AuxExp following WHERE 
/* end ByPass (WHERE) 


/* default - return resuleuee 
/* first AuxDefs 
/* end AuxExp 


“7 
“7 


“7 
as 
“_ 
7 


=i 
*} 
ee 


[RK KK IK II III I KI I KIKI TOI II IO II ee / 


ae le 


AuxDefs (root) 


/* root is a ptr to tree/subtree 


/* currently working with 


<AUXAND> 


/* address of data struct holding 


/* set up its side of subtree 


NodeRec -=rOGt: 
i= <AUXDEFS> ::= (<DATAAUAXDEF> | <FUNAUXDEF>) 
/* Where "<AUXAND> " need not be present. 
{ 
NodeRec *Cemp; 
beg aet flag, 
long pes: 

/* identifier name 
1E( (ptr = ByPass (IDENT PETER) ) )) 
{ temp = CreateNode (IDENTIFIER ); 
temp ->index = ptr; 


LE(BYPdss(ECUIY I): 
{ *root = CreateNode (DATAAUXDEF) ; 
(*YOOt) =>lptr = temp; 
if (Expression (&((*root) ->rptr))!= TRUE) 
EErortandler (line no, EkKRee, 
(long) KW_+WHERE ); 
} 


else 

{ *root = CreateNode (FUNAUXDEF) ; 
(*root) ->lptr = CreateNode(FUNID) ; 
(*noOot).)—7 lper->lstr = temp; 


if ((Pormalst(s (*ro00t) =>lotr—>rptr) 
'= TRUE) ) 
ErrorHandler (line _no,ERR e, 
(long) EOUZY =); 


if (!ByPass (EQUIV_)) 
Errortandiler (linewno, ERR IE, 
(long) KW_+WHERE_); 
else 
if ((Expression(& ((*root) —>rptr) ) 
f= FT RUE))) 
ErrorHandler(line _no,ERR c, 
(long) KW_+WHERE ); 
} 
goto CHECK: 
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/* Vooking fora los == 
/* found 
/* attach temp ptr to roen 
/* now need Exp 

/* NOCCLt, Servs of ix 


/* ena Byfass ECUL se 
/* not ‘==! 
/* will look for ID FORMALS 
/* attach’ 1D co PUN 

/* need the FORMALS 

/* note, tryete sri 

/* Looking for '‘==',already 
/* Greated PUNAUXDER 

/* need QualExp on rt 

/* note the errors, try & fix 


/* end else not ‘==' 

/* found something so need to 
/* check  £6r-more 

Vi end if ID 


It's a DATAAUXDEF 


so must be ID FORMALS 


"7 
“7 


vs 
— 
a! 


=) 


“7 
es! 
+7 
7 


“4 
ai 
“7 
7 


[AREA ota r nicl, sO uLeOkK ytEOr HORMALS == EXP een a 


mec@rtlaq = Formals (root) ) != FALSE) ) /* found something = 

{ 1£ (tlag==ERROR ) 
ErrorHandler (line _no,ERR_e, PeanOue nw enya £1x ay 

(Hong VEOUlV )3 
if (ByPass (EQUIV )) /* looking for == «/ 
{ MakeNewRoot (root, DATAAUXDEF, LEFT) ; /* found ==, so fix tree x / 
RE UE xXpnession(a( (* root) =2Eptr) ) 7* need Expeon rt <7 
!'= TRUE) ) 

ErrorHandler (line _no,ERR c, /* note,try fix a7 


(long) KW_+WHERE_); 
jelse 
BEweonnanglen (line no, ERR jf, 
(long) KW_+WHERE ); 


Goce CHECK: /* found somenthig so check for =/ 
/* more auxdefs ai A 

} 
Becurn(f lag); /* default - none of the above irs 
CHECK: /* found something so need to nad 
/* check for more def's iy | 


AuxAnd(root); 


Pesurn{(T RUE) ; /* any errors have been noted, a 
/* sO press on say 
} /* end AuxDefs x / 


[RRR KKK KK KKK KKK KKK KR KKK KKK RK KKK KEK KKK KKK KKK KKK KK KK KKK KKK KKK KKK KR KK KKK KR RK / 


void 
AuxAnd (root) /* root is a ptr to tree/subtree */ 
NodeRec TOO: /* currently working with <u 
/* <AUXAND> ::= and <AUXDEFS> ar | 
;* Where "and <AUXDEFS>" need not be present. if 
/* Note: This function assumes root is not NULL upon entry Ky 


{ 
if (ByPass (KW_+AND_)) 


{ MakeNewRoot (root, AUXAND, LEFT) ; PA Eounay “and” So fix tree = 
1f((AuxDefs (&(*root)->rptr) != TRUE) ) 
ErrorHandler (line _no,ERR_h, Jemnoce lle. try Go tix Hs 
(long) KW_+WHERE ); 
} /* end ByPass AND oo 
} es end AuxAnd a 
[RK KK KKK IKK IK II I IK TK TIKI II II II I / 
ant 
Formals (root) /* root is a ptr to tree/subtree */ 
NodeRec <*TOCt 7 VCuerentiy working with ni 4 
_ “PORMALO 2 — <b> \[)'(' “<FORMALS> ',' ')! a 
{ 
NodeRec ‘Lemp, “workingroots /* temp ptrs to nodes in tree hs 
/* workingptr marches down the ny | 
/* rt side of the subtree ah 
long Pex; 
iem(pcr = ByPass(IDENTIFIER ))) /* cnecking for just an ID na 
es ooe — CreateNode (IDENTIFIER ); 
(*root) ~=>index = ptr; 


return (TRUE) ; 
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if (ByPass(LTPAREN )) 
{ *root = CreateNode (FORMAL) ; 
if ( (Formals (4 ((* root) —>l ptr) jt =TRUE 
ErrorHandler(line_no,ERR_e, 
(long) RTPAREN ); 


WOrkKingrooes= Il fooc): 


while (ByPass (COMMA )) 


{ workingroot ->rptr=CreateNode (COMMA ); 


temp = workingroot->rptr; 

if ( (Formals (& (temp->lptr)) !=TRUE) ) 

ErrorHandler (line_no,ERR_e, 
(long) RTPAREN _); 


workingroot = workingroot->rptr; 


IT (BYPass (REEAREND) ) 


{ if(*root == workingroot) 
{ V*nOOU = -("EO0G)- >I ptr, 
free(workingroot) ; 
} 
return ( TRUE). 
} 
ErrorHandler(line no,ERR_j,NULL); 
return (ERROR _); 
} 
return (FALSE) ; 
} 


[RK KKK KK RK KK KKK KK KK KK KK Kk kk ek ek 


DAG 
Expression (root) 
NodeRec "= rO0C. 
/* <EXPRESSION> +:= <CONJUNCTION> 
{ 
le gue flag; 
1f£t{ttilag = Gonjunct iloniroot))}) == TRUE) ) 


if (ByPass (ORLOG_)) 
{ MakeNewRoot (root,ORLOG , LEFT); 
LEC (EXDPressi On (ait “Loot) —-rete))) '=[RUE)) 
{ ErrorHandler(line_no,ERR8, 
(long) ORLOG ); 
return(ERROR ); 
} 
} 
return(flag); 


5 


[KK I I IK I I II I III III II III II I III III IK I  / 
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/* end if ByPass ID 


/* checking for '(' FORMALS am 


/* 
/* 


recumsilversearen 
note it,try & fix 


/* 
pe 
i * 
/* 


set the working ptr for later 
use 

have '(' 
Corsi 


FORMALS now looking 


/* 
/* 
7 = 
/* 


found ',' attach it to @eeuiemeee 
recursive search 

need FORMALS following ',' 
note 1t,;try es cx 


/* end while ByPass COMMA 
/* 
/* 
/* 


leoking sor 
'(' FORMALS 
compact the tree - only one ID 


‘)' already found 


/* 
/* 


end of compaction 
end of compaction 


/* 
/* 


end if RTPAREN 
missing °°)! after sae 

/* end if ByPass LTPAREN 

/* default - none of the above 
/* end Formals () 


/* root is a ptr to tree/subtree 
/* currently working witn 


( \/“SEXPRESSICN = 


/* 
/* 
[= 
/ 
/* 


look for Gonjuneeron 
will recursively check for \/ 
found, so fix root form yreram 
/\ w/o following saxo 
Just note it, no tims 


/* end Tecurs1 Vvesnseanuen 


/* end Expression () 


a 
= 


“7 
“7 


“— 
“4 
*7 
al 


“7 
“7 
a 
“7 


“7 


| 
7 
7 


a 
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“7 
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“7 
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st 
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PUBLIC DOMAIN SOFTWARE is 
* Name : parser pt 2 « 
* File : parser2.c * 
* Authors : Meg ws eokte, “Capt J... CONNELL 
* Started ; Oy 207 36 * 
* Archived =: 127 Wily 36 * 
Slodt ried @=. Qi727/87 = ErrorsRecovery added. JC x 
KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KEK KKK 
x This file contains the following modules for the PHI parser: * 
; Conjgunces on () Negation () Relation () Relator () * 
x SimplExp () AddoOp () MullOP () Term () * 
* Factor () Primary () Application () Actual () * 
* * 
* Algorithm : See parser part 1 * 
* * 
Kea KKK KKK KKK KKK KKK KK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KK KKK KKK KKK KKK KKK 
Se hodified : 12/26/86 Flattened tree output changed to abstract = 
. SYOQGameecee form. JC is 
* meow 107 Oo  @eCeErecrrons tO Comply with latest definitions * 
* of the language. JC * 
“ : 01/27/87 Error Recovery added and files combined. JC x 
mae KK KKKKKKKKKKAKKAKKKKAKKKKKKKKKAKEKEKEKKKKKKKKKKKKKKKKKKKKKKKKKKKKKRKKKKEKKE / 


mynclude <stdio.h> 
#include <parser.h> 


extern int line no; /* global var, holds current line */ 
{A eROwOL sOurce preg es 
extern int rebrket; /* global flag - aids in making +f 
/* PHI deterministic « / 


[RR KK KK KK IK IK IO IKI IOI III IOI TOTO II IOI I IC ke / 


emit 
Sen junction (root) /* root is a ptr to tree/subtree */ 
NodeRec gf ale lel ee J sCuUrTEent ly WOrking with ear 4 
/* <CONJUNCTION> = <NEGATION> ( /\ <CONJUNCTION>) * x / 
{ 
Ligue flag; 
if((flag = Negation(root)) == TRUE) y= 100k for Negation part ay 
if (ByPass (ANDLOG )) (ew rectivsively seneck for /\.-*/ 
{ MakeNewRoot (root,ANDLOG , LEFT); Ve Seon, tix root Lor return xo 
merConjgunecion(s ({*root) —>rptr)). != TRUE) /* /\ w/o following Neg. iy 
or rOrlanarern( Pine no, ERRS, /PSIUStenoce Ve, no £1 =a 


(long) ANDLOG_);/* 
return (ERROR_); 


} /* end recursive search ir 


return(flag); 
(ene -COn JUNGELON () ey 


[ORK IO III III III OI III IOI IO I III IOI IOI / 


iene 
Negation (root) /* root is a ptr to tree/subtree */ 
NodeRec a POG t,. /* currently working with =] 
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/* <NEGATION> ::= 


if (ByPass (NEGLOG )) 

{ *root = CreateNode (NEGLOG ); 
if (Relation (¢€((*root) ->rptr) )e'= ieee, 
{ ErrorHandler({line _no,ERRS, 

(long) NEGLOG ); 
retura(ERROna 

} 
else retvnn (| (RUE: 

} 

else return (Relation (root)); 

} 


[RRR RK RRR KKK KKK KKK KK KEK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK 


~ <RELATION- 


/*® (took for —= 
/* found a = 


/* ~ w/o Relation. 


/* note it, no 


fox 


/* end if NEGLOG 
/* just check for single velauumae 
/* end NEGATION 


a 


Just notewune 


ei ghe 

Relation(root) /* root is a ptr to tree/subtree 
NodeRec =F POOL: /* currently working wee 

/* <RELATION> ::= <SIMPLEXP> ( <RELATOR><SIMPLEXP>) * 

/* Where <RELATOR><SIMPLEXP> need not be present 


{ 
int flag,. type; 


if((flag = SimplExp(tcoel)) ==" TRUE) 


if(argbind && IBall(RTBRAKET ,2)) 
return(flag); 
else if (type = Relator ()) 
{ 
MakeNewRoot (root,type, LEFT) ; 
if (SimplExp(s ((*root)=>rptr))!= TRUE) 
{ ErrorHandler(line_no,ERR8, 
(long) type); 
return(ERROR ); 
} 


recuratilagi:: 


[KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK KKK KKK KK KKK KK KK KK 


Bene 
Relator () 
/* <RELATOR> ;::= = | eco a3 
ae Note: returns the Relator 
Dake flag; 
if((flag=ByPass (EQ ))) ; 
else if ((flag=ByPass(NEQ ))) ; 
else if((flag=ByPass (LEQ ))) ; 
else if((flag=ByPass(GEQ ))) ; 
else if((flag=ByPass(KW_+IN ))) ; 
else if((flag=ByPass (KW_+NOTIN_))) ; 
else if ((f£lag=ByPass (KW_+LESS _))) ; 


else TE ( (flag —ByPassi hw + GREATERS))) ; 


86 


/* type is kind of relator found 


/* leoking  @ecn 


/* ArgBind() 6 


a Term. Need to 
/* look ahead for ")' due toupee 
/* of having been called from 
ArgBind() looking 
/* for ™ <QualExp><Op> aes 
/* following first <Ger 


/* recursively check for more 


/* RELATION's 
/* found one, 
/* RELATOR w/o 
/* note 1t, no 


fix root for Yvette 


SimpExp. Just 


£ J 
iE aL 


/* end recursive search 


/* end RELATION 


| > | <= oe 
value vice TRUE 


/* do aoting 


in | notrta 
L£ £oung 


nore 


“7 
7 
«7 
“/ 


— 
7 


a 
4 


ee! 


Beeurn(t lag) ; /* return result of search oi 
} /* end Relator «f 
eee Ore as ed is ee Re eX KKK AAKKEAKKKK KARE RAKKAAKAERKEKKKKKKKER / 


als 
Simp lexp (soot) /**rOCt iS a -ptr=sto tree/subtree */ 
NodeRec Se EOcit.: /* currently working with aif 
/* <SIMPLEXP> ::= <TERM> ( <ADDOP><SIMPLEXP>) * xy 
{ 
int flag. type: /eyoe teeing "OL reldtor found */ 
if ((flag=Term(root) )== TRUE) i= Nook ing for a Term ey) 
Po (aegoind eb lealtl (RIBRAKET ,2)) /* Need to look ahead for ']' due */ 
return(flag); 7 * CO .pOSsioriitys of Navying been © */ 
/ scoalled from Aras une ) and ey 
/*heqpind looking sror <Qualkxp> x / 
i <Op> *)\" tolowiung. <Op> ef 
else if (type=AddOp() ) /* recursively check for more aad 
7* SIMPLEX“ s aes 
{ MakeNewRoot (root,type, LEFT); 7 SEOURG ACCOR so fix root: for ay 
/* return a | 
Bets eiolexpn se ((=root)—>rpotr))!= TRUE) /* AddOp w/o SimpExp. Note it is 
{ ErrorHandler (line no,ERR8, Pe nOCe LC. Mo .cix 3 4 
(Yong) © yoe):; 
Return (ERROR), 
} 
} /* end recursive search uf 


mecurn.(f£ lag) >; 
} f/* ena Simpl Exp « / 
[KI II KI IKI III II IOI IO II IO III II I KI I / 


iifole 
AddOp () 
= <ADDOP> ::= 2) lee 4! een ams -y, 
/* Returns the AddOp value vice TRUE if found an 
{ 
LAG Elag; 

if((flag=ByPass (ADD ))) ; f* Coenoening a 

else if ((flag=ByPass (SUB ))) : 

else lf ((flag=ByPass (COLON ))) ; 

else 1f((flag=ByPass (CAT_))) ; 

return(flaq); {/°Scecurn result of search */ 
} /* end AddOp */ 


[RK RK IKI III III III II IOI III III III III I / 


int 
MulOp () 
y= <MULOP> ::= Ae ey ee ere ike) ays 
cs Returns the MulOp value vice TRUE if found ee 


( 
ant flag; 


if ((flag=ByPass (MULT ))) ; f* 86 Nothing = 


else if((flag=ByPass(RDIV_))) ; 
else Et (Llag-ByPass(IDIV_))) -; 
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} 


return (flag, 


/* return result of searen 


/* GNC Relator 


*7 
“7 


[ RRKKKKKEK ERK KKK KKKKKKKKRKKKKKKKKKKRKKKKAREKKEAARKREKKE AR ® XK Re 


BE ONE 


Term(root) 


} 


[RRR KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KK 


NodeRec ** EOE. 
<LERM> se: 
flag, type; 
if ((flage= Faceor(rece) )s == TRUE) 


if(argbind && IBall(RTBRAKET ,2)) 
return (i lag), 
else if(type = MulOp()) 


{ MakeNewRoot (root, type, LEFT) ; 
LECTErEM (6 (4 * Foot} —>rptr)). t= 
{ ErrorRandler(line no, ERR8, 
(long)type); 
return (ERROR ); 


} 
return {lag 


I, 
we 


factor (root) 


1 
, 


[RRR KKK KKK KKK KKK KK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KK 


Prd 
a ele 


/* 


{ 


NodeRec ~OOc 


<FACTOR> 


Status; 


if(status = ByPass(ADD )) 
*root = CreateNode(POS ); 

else if(status = ByPass(SUB )) 
*“sCot —) CEeatenede (NEG... 


ie CStacusi 


<PACTOR? 


TRUE) 


/* root is a ptr to tree/subtree 
/* currently working wicn 


( <MULOP><TERM> )* 


/* type is kind of relator foun 


/* looking sicrsfacec: 

/* Need to look ahead for 'J' due 
/* to possibility of having been 
/* called from ArgBind() 
/* looking for <QualExpe wages 
/* *) followings op ome 


/* will recursively” look tae 
/* more TERM's 

/* fnd MulOp, so fix Yrootwias 
/* MulOp w/o following Terme 
/* note it, ne bie 


reg 


/* end recursive seare: 


/* end Term 


/* root is a ptr to tree/subtree 
/* currently working wit 


{+|=]<PRIMAR 


Lf (Primary (64 (*rooe)—>r ptr) ) '=fRUE) 


{. ‘Exrorthandler (line me, 2RRS, 
(Tong) status) ; 
FeturateERKOR )7 
} 
else 
else 


Trecurcnt TRUE) 
return (Primary (root) ); 


LAL 
mary (root) 
NodeRec == Toor: 
<PRIMARY> = 


<APPLICATION> 
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/* check for 14‘ vor se 


/* found $+" or. 
/* MulOp w/o following Term. 
/* note 1t, no fix 


/* default, check for Prima 
/* end FACTOR 


/* root is a ptr to tree/subtree 
/* currently working with 


('<PRIMARY>) 


"7 
ay 


ai 
7 
ag 


"7 
7 


& ArgBind*/ 


Bi 
"7 


*7 
“7 
«7 
“7 
“7 


“a 
“7 
«7 
7 
“7 


7 


ie’ 


as 
Bi 
<7 


4 
a 
a 


<7 
Bie 


as 


ony = flag; 


ii tebace=-Applicat ton (root) ) 


if(argbind && IBall(RTBRAKET_,2)) 
recurnt(ftlag); 
else eee yeass toUBOCRIPT )) 


{ MakeNewRoct (root, SUBSCRIPT ,LEFT); 
et Primary (6 ( (*roOcl) —>rper) )) 
{ ErrorHandler(line_no,ERR8, 
(long) SUBSCRIPT _); 
PeCurn (ERROR)? 


} 
recurs (flag); 


} 


fp * 
/* 
/* 
/* 
/* 


/* 
/* 
/* 
f= 
/* 


Tooking, sen.an Application 
Need to look ahead for 


1? 
P 


t 


GUue EG "possibility of naving 
been called from ArgBind() 


and *ArgBind() 
<QualExp><Op> 'J' 


Noplication 


found one so fix tree 


leox1ng for 


m1 Wi] toLLOWLNG) Primary. 


following ' 
recursively look for next 


(LORS own ike 


Mo. Lf ix 


/* end recursive search 


/* end Primary () 


t 


a 


wc 
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cole 
reel cation(root) 
NodeRec OK ONS S 


/* <APPLICATION> ::= 
{ 

seh 
NodeRec 


flag: 
FEnode; 


Pee lag = ACtual (roct)) == TRUE) 
met (flag Application(&tnode)) == 
{ MakeNewRoot (root, ACTUALLIST, LEFT); 
U42O00U) =Srptr = cCnode; 
Ma *hOOt) =» rotr—-oname = 
MakeNewRoot (&((*root)->rptr), 
ACTUALLIST, LEFT) ; 


} 

else if(flag == ERROR_) 
ErrorHandler (line no,ERR_k,NULL); 

Bese] relurn (TRUE); 


return(flag); 


} 


TRUE) 


ACTUALLIST) 


fea rOOe 5 Ae per BO it 


ree/subtree 


/* currently working with 


(<ACTUAL>) + 


/* temp pointer to 
7* 1OCK Foran actual 


J = Gok for an actual 


Pe fis Ereetsoe all Ac 
j= hang Oo GET */ 


node 


eet 


tval's 


/* end 12 (Apelicationtset node) 


J/* 1 nValia Aceiuallist 
i= Note-ve, no fix 


Jean rener valid ACtual List. OF 


/* just a single actu 
(= eGecturn ERROR. or F 
/* based on first loo 
/* end Application () 


ak 
ALSE, 
k 
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nt 

Actual (root) /* root is a ptr to tree/subtree 
NoceRec ST OOe. ye ecurrent ly working with 

/* SACTIUAL> ::= <ID>|! file<LITERAL> | <CONDITIONAL> |<BLOCK?> | 

;* <DENOTATION> | <COMPOUND> | <ARGBINDING> 


{ 


long pir; 
NodeRec =Cemp? 
ae t Elag; 


Me ((ptr = ByPass(IDENTIFIER ))) 


our OuGararstruct (holding the 


/* actual Value of ID 
/* ptr to temp node i 


fe Veneckingeror ID 


Re eo 
n the tree 


a7 
aad 


a 


ars 


a 
a 


{ *root = reatenode (IDENT TE TERE), 
(*ro00c) @-indexs= spre. 


if (ByP ass (LINERTARROW )) 
{ 
MakeNewRoot (root, LINERTARROW , LEFT) ; 
if (Actual (& ((*root)->rptr)) == TRUE) 
return {TRUE) ; 
else 
{ ErrorHandler(line no,ERR8, 
(long) LINERTARROW_); 
return (ERROR_); 


} 
return (TRUE); 


} 


if ( ByPass (KW eet eee) 
{ "root = CreateNode(KW + FILE ); 
it (( pee sey edss (LITERAL) 
{ temp = CreateNode(LITERAL ); 
temp ->index = ptr; 
(*=LTOOU }) *=Sr per =. temp, 
return CERUE): 
} 
else 
{ ErrorHandler(line no,ERR_1,NULL); 
return(ERROR_); 


} 


if ((flag = Conditional (root)) != FALSE) 
return (flag) ; 

if “(flag =) Block (root) ). '= FALSE) 
retumn (f1aq) - 

if ((flag = Compound(root)) == TRUE) 

if (!ByPass (LINERTARROW_)) return (TRUE) ; 

else 

{ temp = *root; 


if(!IsFormal (temp) ) 
ErrorHandler (line _no,ERR_o,NULL); 
(*root) =2name = FCRMAL; 
MakeNewRoot (root, LINERTARROW , LEFT); 
if (Actual (&((*root)->rptr)) == TRUE) 
return (TRUE) 
else 
{ ErrorHandler(line_no,ERR8, 
(long) LINERTARROW ); 
return (ERROR): 


} 


else if (flag == ERROR_) 
return (ERROR _); 
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/* 
/* 
/* 
/* 
/* 


/* 


/* 
/* 


/* 


/* 


Ye 


j/* 
F 


/* 


/* 
p* 
/* 
/* 
/* 
/* 


/* 
78) 
/* 
/* 
/* 


J= 


/* 


/* 


Wag 


now look for ID |=> AGTUAE 
Note: “ID |=-> ACTUAL” vsia 
<DENOTATION> 

found one so fix tree 

look’ for Czar Ae7Gan 


note if) no ri 


end else not Actual () 
end if LINERTARROW 


end if ID 


found keyword FILE 


attach following LITERAL 


end if LITERAL __ 
note it, no £1ix 


end if FILE_ 


Phi is nondeterministic must 

first check for compounds then 
if |-> follows must see if the 
compound was actually a fermals 


list NOTE: Order may NOT be 
changed! ! 
had "{->" now need to see if 


had Formals 

set var to be passed by value 
to IsFormals 

just report it and press on 


found one so fix tree 
look foretrallIPaeleAL 


note. Le, one er bx 


end else ByPass LINERTARROW 





if ((flag = Denotation({root)) != FALSE) 
return(flag); 


Pee lag =wArGbinding (LOOe)) = FALSE) 
FEEUUN( lag); 


recurn (FALSE)? /* Default, tried everything else */ 


} /* end Actual() ad 
eee eee eer ce ene Se RR RAK ERE KERR REE EEE KRERERKKRKEKKKKK KKK KK / 
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PUBLIC DOMAIN SOFTWARE 


Name : parser pt 3 

File ee parser3.c 

Authors : Maj E.J. COLE / Capt J.-E. Genie 
Started : Oy 20736 


Archived : Ay Lal Mos 
Modified as: 01/27/87 - Error Recovery added. we 


ww KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KEK KKK KKK KK KKK KKK KKK KKK KKK KKK K 


This file contains the following modules for the PHie parser. 


Conditvonal Arm () Block) Compound () 
Elements () Denotation() ArgBind() Ope) 
TypeExp () TypeDom() TypeTerm() TypeFac () 


TypePrimary () PrimType () 


Algorithm : See parser part 1l 


RRR KR KEK KEKE KK KEK KERR KKK KKK KEK KKK KKK KKK KKK KKK KK KKK KR KEKE KKK KKK KKK KEKE KK KK KKK KK 


Modified > 12/26/86 Flattened tree output changed to abstract 
SYNtax Ernee Eorm. JC 
01/10/87 Corrections to comply with latest definitions 
Of Ene Language... Jc 
01/27/87 Error Recovery added and files combined. JC 


KR KR KKK KEK KEKE KKK KKK KKK KEK KKK KKK KKK KEK KKK KKK KEK KKK KKK KK KKK KKK KK KKK KKK KKK 


+ + * © * © 4 4 HH FH HF F* &H 4H 4H HH & HH HF HF YF 
ee ee a a ee i i i i i a i, a a, a, a, a, a i, a, a, a. 2 


#include <stdio.h> 
t*include <parser.n> 


extern “unt robr<et; /* global flag — a1icemea *7 
/* making PHI deterministic be 
extern int Line ino; /* global var, current) time a 
/* number of program be 


[KKK KKK KKK KK KKK KKK KK KK KR KK KKK KKK KK KKK KK KKK KK KKK KKK KKK KKK KK KKK KK KK KK KK KK / 


int 
Ceongi tional root ) /* root is a ptr to tree/subtree */ 
NodeRec AS OOu, /* currently working wien "7 


/* <CONDITIONAL> ::= if <ARM> (elsif<ARM>)* (else<EXPRESSION)1 endif */ 


/* ptrs to temp nodes in the trecuam 
NodeRec “Cenp = NULL, *SUSIOOL,. “workingpetr; 


if(ByPass(KW + IF_)) 


{ if(Arm(&temp) != TRUE) 
Er vOruander (line no, BRR om, (long) 15a) /* NOCe Ie, ery ecu 7 
"root = CreateNode(KW_ + IF_); /* set up root for reeur:, =, 
(*root) ->lptr = temp; /* attach THEN exp tomweaes “7 
WOCKINGpEr = * roou; /* move working ptr <7 


while(ByPass(KW_ + ELSIF_)) 


i. “subroet = Creavenoge(rwi + Elsie a) 
WOrKINGPEY —->FptY = subroer; /* attach ELSIF to tree =) 
if(Arm(&temp) != TRUE) 
ErrorHandler(line_no,ERR_m, /* note it, ery seer. 7 
(Tong) BUSiP se); 
subroot ->lptr = temp; /* attach THEN exp Co Eee. Be! 
WOrKINGOET = WOrKIngetr =SrcEr, /* move wrking ptr down subtree a 


} /* end while ELSIF “i 
if (ByPass( KW. + 7ELSE)) 
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} 


{ if (Expression(&temp) != TRUE) 
ErrorHandler(line no,ERR o, 
(long) ELSE ); 


subroot = CreateNode (KW + ELSE ); 


workingptr ->rptr = subroot,; 
subroot ->lptr = temp; 


workingptr = workingptr ->rptr, 


} 
Meteyedss(hWo + ENDIF )) 


{ temp = CreateNode (KW + ENDIF); 


workingptr ->rptr = temp; 
jselse 


{ ErrorHandler(line no,ERR_n, NULL); 


if(IBall (ENDIF _,1) || 
EatEm(ENDIF ); 


} 
return (LRUE) >; 


return(FALSE) ; 


} 


PBa ll vENDIE =, 2)) 


me IROCe VE, rye £1xX 


/* attach ELSE to tree 

ana ach EAPRESSION Co ELSE 

/* move wrking ptr dewn subtree 
/* ene SESE 


JF NOPe le sand tTY «Coo cix = 
/* will return TRUE regardless 
/* look 2 ahead for the END 


7* 6nd Clse  a0cesyeacSeeNDIF 
/* saw an IF, any errors they 
/* were already reported 

/* end if IF 

/* didn't see an IF 

/* end Conditional () 


ae 
ig f 
a 


ay 
yf 
Y 
Te 
oie 
ward 
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deni 
fem (Coot ) 
NodeRec = root: 
ye <ARM> ::= 
{ 
ae he iba? 


NodeRec *temp = NULL; 


ae 


af 


{ 


} 


(flag = Expression(&temp)) != TRUE) 
BatemiKWet THEN.) 

(eyPass (KW...+ THEN) )) 

mecOu— creaLleNnocae (KW. + THEN ); 


[-roOu) -—> Iptr = temp; 
if (Expression(&temp) == TRUE) 
CErOOL) “=2 retr = temp; 

else 
Erropdandber (line no,ERR_m, 
(Vong) THEN ); 


else 


ee 
} 


[KK II IO IOI OOO IO OI OK 


ErrorHandler (line no,ERR f, 
(long) KW_+THEN ); 
urn(flag); 


BeTye 
mpock (Toot) 

NodeRec **=rOOt 
/* <—SlOck> = 
{ 

stig (ByPass (KW_ + BEGIN )) 


{ 


meQote— CreateNode (KW + BEGIN ); 


if (BlockBody (&((*root) ->lptr)) != TRUE) 


Se 


/* root is a ptr to tree/subtree 
/= "currently working with 


<EXPRESSION>then<EXPRESSION> 


,* temp per tora node in tree 


Psi anierror try to recover by 


paeroOokmror THEN, ELSE, 2 bole, ENDIS 


(]Sepore lt sand try to press on 


/* end begin if THEN 


jee report tt and try to press on 


/* end Arm() 


/* root is a ptr to tree/subtree 
j= GuErently working With 


begin <BLOCKBODY> end 


/* sets root for return errors 
/* have already been reported 
J *e look for BLOCKBODY 


ey 


a | 
af 


a & 


al) 
my 


= 
Re 


ied 
ive 


ar 


alt 
maf 
otf 


ErrorHandler(line_no, ERR_m, /*ROES) TE wee hy) aa ee “7 
(long) BEGING)— 
if (ByPass (KW END )) 
{ (*root) ->rptr = CreateNode (kW + Eras 
reCurn (ERC r.. 


} /* end bypass END «/ 
ErrorHandler(iinewns, ERREL, /* note” emacs ay / 
(long) KW_+END_); 
Fecurn (ERROR ee, 
} /* end ByPass BEGIN ie 
else FeLUuEn (PALSE)s, 
} /* end BLOCK x / 


[RRR KEKE KKKKKKKEKKEKKKKEKKKKKKKKKKKEKKKKKKKKKKKKRKAKKKKK RARE K XX Xe 


WAC 
Compound (root) /* root is a ptr to tree/subtree */ 
NodeRec ee roOu: /* currently working wid «/ 


/* <COMPOUND> ::= '('<ELEMENTS>') '|'{'<ELEMENTS>'‘}° | '<'<ELEMEN@D oe x/ 


/* where <ELEMENTS> may be empty */ 
{ 
if (ByPass (LTPAREN )) 
{ Elements (root); /* only look for elemt's because */ 
/* errors reported via QualExp “7 
if (!ByPass(RTPAREN_)) /* note ibs. no sti 7 


Errordandler (line ng, ERRee, 
(long) RTPAREN ); 


1f(*root == NULL) /* now check for empty compounds/ */ 
*root = CreateNode(EMPTYCOMPOUND) ; /* compounds w/ multiple elements */ 
else if((*root)->name == COMMA_) 


(* Toot) —sname: = ELLIST; 
Petuyi (CRUE): 


} /* end if LTPAREN) it) 
1f (BYyPass(LISOUIG )) /* Only look for enr a 
{ Elements (root); /* errors reported via QualExp we 
1f ({ByPass(RTSQUIG )) 
ErrorHandler(line no,ERR f, /* note 18, nore 7 


(long) RESQUIG ); 


1f(*root == NULL) /* check for empty compounds ancua 
*root = CreateNode(EMPTYCOMPOUND) ; /* compounds w/ multiple elements */ 
else 1f((*root)->name == COMMA_) 


(*root)-~>name = ELLIST; 
return(TRUE) ; 


} /* end if LTSQUIG) sy 
if (ay Pass (ST (SEQUENCE) ) /* only look 865 sen, by! 
{ Elements (root); /* errors reported via QualExp pe 
if(!ByPass (END SEQUENCE )) 
ExrorHandler(linesne,ERR£, /* note it & no fix bi! 
(long) END SEQUENCE ); 
if (*root == NULL) /* now check for empty sequences/ */ 
*root = CreateNode (EMPTYSEQUENCE) ; /* sequences w/ multiple elements */ 
else MakeNewRoot (root, SEQUENCE, RIGHT); 
return (LRUE); 
} /* end ByPass ST_SEQUENCE_ a 
return(FALSE) ; /* none of the above a! 
} /* end Compound () 7 
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94 


nig giye 


Elements (root) /* root is a ptr to tree/subtree */ 
NodeRec ROC Gy /* teQerentily working with = / 
/* <ELEMENTS> ::= <QUALEXP> (, <QUALEXP>) * x / 
{ 
ing a flag; 
if((flag = QualExp(root)) == ERROR ) 
EatEm (COMMA _); /* errors already reported aes 
while (ByPass (COMMA_)) /*~ Tecursively look forenext a 
/* qualexp =] 
{ MakeNewRoot (root, COMMA_,LEFT); /* found a COMMA so fix tree ol 
Hew Elements (6(1- root) —Srpetr)) != TRUE) 
ErrorHandler(line_no,ERR_p, 
(long) COMMA _); Po emOTe itu ry & [1X oa 
G6¢(“roOce)y-— =retr—--name != COMMA ) pe= ele Greems©o. all Oualixp’s a 
MakeNewRoot (&((*root)->rptr), 
SOMMA. , LEFT); / = Mang tO. the LEFT mf 
} 
/* end while ByPass (COMMA ) 7 


Beuurn (flag) ; 


} /* end Elements () oa! 
[5 II III I III IOI III III IO I IOI I IOI III IC / 


fer te 
Denotation (root) Je TOOu 8S a ptr to tree/subtree */ 
NodeRec -*TCoOL; 7 * Currently working with oh 
/* <DENOTATION> ::= <LITERAL> | <CONSTANT> | <FORMALS>|-> <ACTUAL> 
* where LITERAL is quoted(') string of zero or more chars and 
* where CONSTANT is an integer or decimal number 


* NOTE: <FORMALS> |-> <ACTUAL> was already checked by Actual () xf 
{ 
long DEL; 


if(ptr = ByPass (LITERAL _)) 
meenooce— crcaceNnode (LITERAL ); 
(*root) ->index = ptr; 
return (TRUE) ; 
/* end a LITERAL a 
Pee (BYPass(EMPT LIT )) 
Mee ceoce— ereaceNode (LITERAL ); 
(*-neoe) =>index ="NULL; 
PeeuEen (LRUE) 
} /* end a LITERAL oi 
if (ptr =ByPass (CONSTANT )) 
fee oOSe— CreateNoce (CONSTANT ); 
(= 2o0b) 9 -—>index = ptr> 
return (TRUE) ; 


} /* end a CONSTANT =f 
mecurn(FALSE) : J7~ Cdetault, mone of the above ie § 
} /* end Denotation() * / 


[KK KK KK KK kK I I II I II I KI III II III FO IK III IK / 


PAC 
meaeinding (root) ("EGO GwiSea pts to Lree/subtree */ 
NodeRec E=TOOLs /* currently working with i 3 
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/*  <ARGBINDING> ::= ‘'[' (<OP><QUALEXP> | <QUALEXP><OP> | <OP>) '‘']! * / 


{ 


ale: specialcase; 
NodeRec *temp = NULL; /* temp ptr to node in tree “7 
extern int argbind; /* global flag needed to make “7 
/* PHI deterministic “i 
Lf (ByPass (LTSRARe Ea /* set global flag, needed to ae 
{ argbind = TRUE; /* PHI determingsrre- 7 
specialcase = (IBall(ADD ,1) || IBall(SUBy eae 


FLEGeS DEBUG 
printf ("special case = %d argbind = %d\n", specialcase, argbind) ; 





#endif 
( 
tf Op (roor):) /* begin Op comes firee 7 
{ if (ByPass(RTBRAKET )) /* looking ienmmler =a 
{ argbind = FALSE; /* reset global flag <7 
MakeNewRoot (root, ARGBINDOP, LEFT) ; | 
return{(TRUE) = /* had [ <Op> ] x / | 
} /* end if ByPass RTBRAKET_ “7 
MakeNewRoot (root, ARGLEADOP, LEFT) ; /* don't have just anv@s =] 
if (iBall (Appe, E) | “iBall (suse )) /* might be +/- +/= Odie 7 
specialcase = FALSE; /* and don't want to accept "7 
/* +/- +/= QualExp Op lateuaem +7 
if ((QualExp (6 (*root) ->rptr) ) ==TRUE) /* two cases where QualExp could */ 
{ /* be TRUE --- <Op><QualExp> <7 
if (ByPass (RTBRAKET )) /* or +|=<QUalExpe<ee- x / 
(-argbind — FALSE; return(TRUE); } /* reset globaletiaa “aa 
else /* could be +/- PRIMARY “7 
if(specialcase && Op(é&temp) 
&& ByPass(RTBRAKET )) 
{ ((* root) =>1 ptr) —>rptr=(*rootj—>rocr. 
(*root) ->rptr = temp; /* now fix the tree x / 
CLC ROOr => pL rn) =oname —— eae eee, 
CGUs 500) >> ptt) ->name=pos.) 
CUie Oot) = ptr) =—sname NEG )i7 
(*root)-> name = ARGTRAILOP; /* <Op> came last as a ",™ bi 
argoind> = FALSE? /* reset globalflag “7 
Fecturn (RUE); 
} /* end else specialcase && Op() <7 
/* && RTBRAKET_ <a 
} /* end 2 cases where QualExp TRUE */ 
argbind = FALSE; /* reset globalflag = 
Brrordandiler (line no, ERR Gg, NULL); /* Lepore. Eazy non a.s "7 
TPECUEA(ERRGR ) > 

} /* end Op comes first 3 

af ((OualExpiroct))) ~!=s FALSE) /* found something 7 

{ MakeNewRoot (root, ARGTRAILOP, LEFT) ; 

argbind = FALSE; /* reset global flag 6& gt // 
LE(OCo (se “rooG) =-rper) 
&& ByPass(RTBRAKET )) /~ see if can continue “7 
return (TRUE); 
ErrorHandler (line_no, ERR_q, NULL) ; /* YTeport 1°, (oomue “% 
return(ERROR ); 

} /* end if QualExp comes Size <7, 
} /* end if ByPass LTBRAKET ay 
return (FALSE): /* default, none of the above ea / 

} /* end ArgBinding |) = 


[KOKI III III IOI IOI III IOI III IOI ITO IKK IOI III IK IK KICK / 


iiglie 
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Goiroor) 
NodeRec ‘Si alerolay 
fis SOP = ale | 
{ 
eee eeag 


if(flag = ByPass (COMMA _)) 
*root = CreateNode (COMMA _); 


else if(flag = ByPass(SUBSCRIPT )) 
BECOEN Creat eNnode (SUBSCRIPT ); 


else if(flag = Relator ()) 
*root = CreateNode(flag); 


else if(flag = AddOp()) 
*root = CreateNode (flag); 


else if(flag = MulOp()) 
*root = CreateNode (flag); 


return(flag); 
} 


<RELATOR> 


/* root is a ptr to tree/subtree 
7/= currently werking with 


| <ADDOP> | <MULOP> 


/* end Op 


ay 
af 


a 


a 
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int 
TYpeEXp (root) 
NodeRec FAUCCE; 
1 <TYPEEXP> ::= 
{ 
NodeRec *newroot; 
mnt flag; 


if((flag = TypeDom(root)) == TRUE) 
if (ByPass(RTARROW )) 
{ newroot = CreateNode(RTARROW ); 


<PYPEDOM> 


DEW lL OOeme > hpL Ei — ~T0O0t ; 
*root = newroot; 
mE (Typebxp(& ((*root)->rptr)) !'= TRUE) 


/* root is a ptr to tree/subtree 
{/* Currently working with 


(So PVP REAL > el 


/* temp ptr to nodes in the tree 


/* will recursively search for 
/* more TYPEEXP's 
Jo EA. POOL, LOr return 


{ ErrorHandler (line no, ERR9, (long) RTARROW ); 


Beturn (ERROR |); 


} 
Bpeturn( flag); 
} 


Vonena recursive searen 


/* end TypeExp 


aes 
wie 


of 


ae | 


mh 
ae 
ee 


a 


ae 
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sige 
TypeDom (root) 
NodeRec [a CooOt; 
i <TYPEDOM> ::= 
{ 
NodeRec ‘*newroot; 
Bert Elag; 
if((flag = TypeTerm(root)) == TRUE) 
if (ByPass(ADD_)) 
{ newroot = CreateNode (TYPEPLUS) ; 
newroot ->lptr = *root; 


/* root is a ptr to tree/subtree 
/* currently working with 


“VEE eRMe (+ <2 YP EDOM) * 


o7 


/* temp ptr to nodes in the tree 


/* will recursively search for 
/* more TYPEDOM's 
JZ @EixerOoot. Lor relurn 


rh 
a 


a 


it 


ay 
ay 
a | 


“root = NewrEroot; 

if (TypeDom Ges rooe) —srper)) fence) 

{ ErrorHandler(line_no, ERR9, (long) ADD_); 
recurn(ERROR®) ; 


} /* end recursive search pe 
retuunielag); 
/* end TypeDom() « / 
[ERK KKK RH KKEKKKKKEKK KKK KKK KKKKEKKEKKKKKKEKKKKKKKEKKKK KKK KE A K&R KE KK Re 


mens 
TypeTerm(root) /* root is a ptr to tree/subtree ie 
NodeRec =F roOu, /* currently working wig <7 
/* <TYPETERM> ::= <TYPEFAC>(‘'*'" <TYPETERM>) * * / 
{ 
NodeRec ‘*newroot; /* temp ptr to nodes in the tree */ 
ne Elag, 
if ((flag = TypeFac(root)) == TRUE) 
if (ByPass (MULT )) /* will recursively search for “7 
{ newroot = CreateNode(TYPETIMES) ; /* more TYPETERMS's “7 
newroot ->lptr = *root; /* €1xX Loot Sorerecurd ey! 
“LOO =, newEoor, 
if (TypeTerm(& ((*root)=>rptr)) != TRUE) 
{ ErrorHandler(line no, ERR9, 
(long) MULT _); 


return (ERROR): 


} /* end recursive search a 
return(flag); 

/* end TypeTerm() as 

[KH KK KIKI I KK III IK IKI KIKI IKK IK IKK ee ee / 


LAE 
TypeFac(root) /* root is a ptr to tree/subtrteauwey 
NodeRec Z*FOOG; /* currently working with = 
/* <EY PRP AC> 22= <TYPEPRIMARY>@ | <TYPEPRIMARY> | * / 
/* <ID> '<<' <TYPEEXP> (,<TYPEEXP>) * ">>! S-feoan 7 
/* Where <<TYPEEXP(, TYPEEXP, ...)>> end/or <AGiv7- 2 +77 
/* need not be present *y 
; 
NodeRec *newroot; /* temp ptr to nodes in the tree */ 
bee lag: 
SONG Pr. 


if(pctr = ByPass(IDENTIFIER )) 
{ ‘*root = CreateNode (IDENTIFIER ); 
(*root) ->index = ptr; 


if (ByPass(ST_SEQUENCE ) && ByPass(ST_ SEQUENCE )) 
{ ErrorHandler(line no,ERR_r,NULL); 
return(ERROR _); 


} /* end bypass << +7 
Gcto, CHEGK: 
} /* ena ite = 7. 
if( (flag = TypePrimary(root)) == TRUE) 
goto Crhren 
return (£ lage. /* return either ERROR or FALSE 7 
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CHECK: if(ByPass(STAR )) 
{ newroot = CreateNode(STAR_); 


newroot ~->lptr = (*root); 
z-Oot = Newreoot- 
} /* end if STAR =f 
Beturat. RUE); /* made it this far, all OK = 


} /* end TypeFac() tay. 
Pe RXR K EKA RR KKK KAR KA KAKA KKAKRKREA KKK KKK AK KKK KEREKKKERRKRK ERK KR AKK KK / 


pm ehe 
TypePrimary (root) /* root is a ptr to tree/subtree */ 

NodeRec SEE OOc, 7/* currently working with maf) 
j * Sire he Ri bMARY> =2— <PRIMIYPE> | ‘(* <TYPEEXP> '‘')' x / 
/* NOTE: ID already checked in TYPEFAC() =), 
{ 

HE\pyrass (LIPAREN )) 

wererr< | YpeCEXp(root) = TRUE) 

EEEOEHana ler line no, ERRG, PIONOEC AT; NO Fix oF 


(long) LTPAREN ); 


if (ByPass(RTPAREN ) ) 
return(TROE); 
else 
(>) ErrorHandler(line no, ERR £, 
(long) RTPAREN ); 
return(ERROR ); 


} /* end ByPass ‘(' «/ 
if (PrimType (root) ) 
BecuUrEn (LRUE); 
Becurni(EALSE) >; /* default oie 
} /* end TypePrimary () ay 


[RKKKKKKKKKK KKK KKK KK RK KK KK KR RK KK RK RR KK RK RK RK RK KK KK KK KKK KK ee / 


Meliss 
PrimType (root) J*1EOOL 1S “a Ptr to tree/subtree. -/ 
NodeRec OO; j= CNTEent ly working witn a 4 


PeecPRIMTYPE> ::= real | integer | natural | boolean | trivial | type */ 


if (ByPass(REAL )) 
meee Coe = CreateNode (REAL ); 
Return (TRUE); 
} /* end if REAL ay 


met ByPass (INTEGER ) ) 
me cOOL = CreateNode (INTEGER ); 
eeturn (TRUE) ; 


} /* end if INTEGER ay 
if (ByPass (NATURAL )) 
{ *root = CreateNode (NATURAL ); 
return (TRUE) ; 
} /* end if NATURAL aye 


if (ByPass (BOOLEAN _)) 
Merc oOc, = CreateNode (BOOLEAN ); 
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return(TRUE) ; 


Li (ByPass (15 ey ieee 

{ *root = CreateNode (TRIVIAL _); 
return (TRUE) ; 

} 


LE (ByPass (AW oP) 

{ *root = CreateNnode (hue TYPE), 
PeCUEnCLRUE 

} 


return(FALSE); 


7% 


qin 


/* 
yas 


end if BOOLEAN 
- 


end if TRIVIAL 


end if TYPE 





default - none of the a 
end PrimType () 


[KI RI I III IIR IRI III III III I III III II II II II III Ik kek ad 
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PUBLIC DOMAIN SOFTWARE 
Parser Utilities 
parsr util.c 
Maj EJ. COLE / Capt J.E. CONNELL 


* 
* Name 

x File 

= AULKOLS 
* Started : 21/26/87 

FeArchived =: Gays) 387 

* Modified : 04/23/87 FillBuffer() now calls GetToken() direct. 
* 

x 

* 

*« 

* 

* 

x 


RIK KKK KKK KKK KKK KKK KKK KK KKK KKK KEK KKK RK KKK RK KKK KKK KKK KK KKK KKK KKK KKK KKK 


Mhas file cComtains the utility modules for the parser: 
CreateNode () MakeNewRoot () ByPass() 
Fav rBuate () IsFormal () [Ba le) 
NodeName () EnterName () FindName () 


KKK KKK KKK KK KKK KKK KKK KK KKK RHR KKK KKK KKK KKK KEK KKK KKK KKK KKK KKK KKK KKK KKK KK 


Modified >: @3/28/87 - Buffer Handling routines added — JC 
* 04/23/87 - FillBufer() calls GetToken() direct vice 
* working with intermediate file of tokens. 
* EnterName() and FindName() added to place 
* IDs, LITERALS, and CONSTANTS into the name 
4 table. Ue 
* 
* 


KKK KK KKK KEK KKK KKK KKK KKK RK KKK KEK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK 


ae ee ee ee ee ee ee ee 


fomnelude <stdio.h> 
#include <parser.h> 


extern int line_no; J* Global Vang nolds ine no 9 | 
i * Of “SOUrCeE prog my 
extern FILE *pinfile; f* Global working file iy 
j= owe toxcen|O|> Lo Value) other aes 
/* than NULL. Token[0) holds the */ 
enar token (MAXLINE]="x"; 7 NengenhcoLr the string. iy 
NameRec *nametable[(TABLESIZE+ 1}, /* add 1 because (0) is unusable ‘*/ 
*EnterName (); 
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ee UPILITIES x / 
NodeRec * 
CreateNode (op) 
NodeType op; /* operator type of node ear 
/* Creates a tree node and returns the pointer (temp) to this node. sy 


/* Accepts node type (op), an integer, and inserts it into the node. */ 
{ 


NodeRec *temp; 
temp = CALLOC(1,NodeRec) ; /* create a node ay 
temp -> name = op; 
temp -> ln = line no; 
temp -> lptr = (temp -> rptr) = NULL; 
return(temp) ; 
} ol end CreateNode () was 
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void 
MakeNewRoot (root, type, side) 
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NodeRec **root; /* old rect vo: ibe cone 
/* will turn inte new veos 
aac type, side; /* (type) is type of new root 


/* (side) is side to att old@pge- 

/* Creates a new working root for subtree. 
/x Old root is attached to lt/rt based on value Gf Misia] 
{ 
NodeRec *newroot; 

newroot = CreateNode (type) ; 

(side == LEFT) ? 

(newroot ->lptr = *root) = (néwroot =>retr = “hoes, 

*root = NeEwroot. 


} /* end MakeNewRoot 


“2 
“7 
"7h 
a 


xy 
a 


“7 
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vold 
Pil EBuk& (seanc) 
long. =Stace: /* which slot in the butees 


/* array to start the fi 03aaag 
/* Requires the buffer array and buffer ptr to be previously defined. 
/* Fills the buffer with tokens by calling GetToken(). Buffer i aied 
/* until 1) end of user prog reached or 2) end of the array reached 
/* If the token is a literal, id, or constant then EnterName() is 
/* called to enter it into the nametable. 


/* Lastly, resets the buffer ptr to tokenbuff[0]. 
{ 
extern Long tekenburet |. -*ptr; 
int token num; /* identifies a token type 
NameRec ‘*nptr; /* ptr to structure of NameRec 
Otr = stdre: /* intit ptr to travel thraeeaae 
do 
{ token num = GetToken(token); 
"ptr = token num; 
,PoE by 


switch (token_num) 

{ case LITERAL 
Case CONSTANE = 
case IOENTIFIERS 


{ token(0] = strlen(token); /* insert length of stig 
1f((nptr=EnterName (token) ) ) 
{) *pte = -(longinptr: /* address of token 
++ptr; 
} 
else Errordandler(NULL, ERR? ZNULE) /* HANDLE MEMORY OVERFLOW! 
break; 
} /* end case 
default: /* doerecn tas 


} /* end switeh 
} while((token_num != EOF) 6&6 
(ptr < &tokenbu 


Str = £teKxerourer|o lr, /* reset the buffer ptr 
, /* end Filiauee@ 


= 
7 
7] 
*7 
*y 
ei 
gs / 
<7 


“7 
“7 


7“ 


we! 


ae 


pi 


“7 
*/ 
<7 


a 
oA 
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eng 


ByPass(tot) 
stg Ege; 
/* Checks to see if the next token in the buffer matches the target. 
/* If so, then returns the token no. and increments the buffer 
(os jee bglal=og 
{ 
extern long Gla fe =sqh ep Shane pre ciehese 
PEt pere>— etoxenbulf | BUFSIZET) /* see if at end of buffer 
Mideast (Gteakenour £[ 0} ) ; Peretti ll butter 
while(*ptr == EOLN ) 
{ ++ptr; /* increment counter & skip 
f+ line no; 
if(ptr == é&tokenbuff [BUFSIZE]) /* see if at end of buff 
FillBuff (&tokenbuff[0]); /* refill buffer 
} /* end while 
Pooper != tot) 


return (FALSE); 


++ptr; /* otherwise, it was found 
if(ptr == &tokenbuff [BUFSIZE}) J/- tt ac end Of Dutter 
FillBuff (&tokenbuff[0]); /* refill buffer 


ewitcn (tgt) 
{ Gase LITERAL 
ease ©DENTIPIER. 


ease CONSTANT © : j Geren pele LO ese EUce 
BeeWen (spt hs.) ) > /* holding the token 
default: /* just return true 
BECEUEM (EGE); 
} /* end swithch 
} /* end ByPass() 


[KR KKK KR KKK KK KK KKK KR OI KO ORR OK OR KO 


ara t 
IsFormal (root) [= TLOOtL 1S pier CO subtree 
NodeRec BEOOt; y= currently working with 


/* Required to make the language deterministic. Compound() returned 
/* TRUE and “|->" was subsquently found. Formal is a proper subset of 
/* the compounds so need to inSure no errors in the formals. 

/* Performs a preorder search of the subtree. NOTE: assumes that root 
feeomitially points to a non-null compound list. 

{ 


#ifdef DEBUG 


orintf("isformal entered, root->name = %d\n",root->name) ; 
mammecoot =— NULL) printf("“root is null\n"); 
#endif 

if (root == NULL) 


BecUrnCLRUE) ; 


if (root->name==COMMA _ root->name==IDENTIFIER _ 


ine 
}| root->name==ELLIST) 
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ay 
i 


zy 


oe) 


ace | 
ae 


i 
ts 


a 


if 
7 
a 


= 
= 


ae 
aif 
wd 
a 
ole 


if ( (IlsFormal (ecet-slpeu) 
&& (IsFormal (veot—>rper) 


} /* end Tstormal x / 
[RRR KK KEKE KEK KERR KERR EK EKEK ERK K KK RR KK Ree 


aig alts 
IBall(tgt, index) 
ine tgt, index: 
/* Checks to see if the (index)th token in the buffer matches the x7 
/* target. If it does returns TRUE else FALSE. Does not increment x7 
/* the buffer pointer. Checks for full buffer implemented in this +7 
/* manner to allow for future flexibility. Could have used simple * ff 
/* heuristic or: 7 
/* if (ptr + (3*index) > &tokenbuff [BUFSIZE]) RefilBuffer; xf 
/* at the expense of generality x / 
extern long COKEH BUC. [| aye per: 
long pS 218 aes 
if({ptr >= étokenburt ([BUFSIZE!) /* see if at end of butte =/ 
FillBurttétokensurtlo))- /* so, refi) butte 7 
/* start over if had to refill A 
DO_ AGAIN: /* buffer during check femmes a7 
ptr = pec. /* set working pointer “7 
while(*tptr == EOLN ) 
(jp =o ioer: /* increment tptr™~ skip EOiMe x 
LE(Cpir == stoxensurs (BUFSIZE)) /* see if at end of buff =7 
goto REFIL; /* nedd to refill buffer and a 
/* then start ovez “y 
/* end while <7 
FOr | pindewe ade s) /* only enter for loop if need to */7 
{. =SWICen cour) /* look more than one cnar ahead */ 
{ case IDENTIFIER ;: /* double skip because next a 
case CONSTANT : /* entry is addr of element a 
case LITERAL: GCPUrL t= 2,7 Drea, 
case EOLN-: 
while(*tptr == EOLN ) 
{Weer raecr: /* increment counter & skip 7 
if(ptr == &tokenbuff(BUFSIZE] ) 
goto REFIL; /* refill buffer & start woven pi 
} /* end while <7 
default: ae tite testes 
} /* end switch “7 
DPEltpcr 2= <cokenbutf(BUrSiIZe]) /* check if will overflow buff eet 
Goto REFIL: 
} /* <endetcr et 
Lf (*tpere! = tat) «return (ease). 
else return (TRUE) ; 
REFIL: /* take what's left in buffer, af 
/* put at beginning, new rena iy 
/* rest of butter a 
for (EDErS=—ecrokenouce (0 |; 
ptr < &étokenbuff(BUFSIZE|} (eee zor 
*COUL ES weOLls /«* refill buffer from Ccurreme ee 
poms |) sete Gejeje re) /* posit touend 7 
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goto DO AGAIN; /* refilled buffer, so start | 

/* over x / 

/* end IBall() -/ 
ee Re I RRR KKKKKKERKKRREKRKKERKKKKKKKKEKRKE | 


char * 
NodeName (ptr) 
NodeRec [Oer; 


/* Accepts a ptr to a structure of NodeRec. Dereferences this node x 

/* to get a ptr to structure of NameRec which hold the string of 

/* containing the name of the value in NodeRec. Returns the name to ays 

peecalling routine a7 

{ 

NameRec *temp; fe{cemp Ptr Go. datanseruct ow f 
j/ iOlaing Name Offs" sptr" st 

temp = (NameRec *) (ptr->index); 


return(temp->name + 1); 
} /* end NodeName() yf 
[KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KR KKK / 
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APPENDIX I 
ROCK COMPILER — ERROR HANDLER 


[RKKKKKKKKEKKKKEKKK KKK KKK KKK KKK KK 


* 

x Name : Error Handler 

* File : errors.c 

* Authors : Mages. COLE a 
* Started : 01/20/87 

x Archived -: 4/27/87 

x Modified 

KKK KKK KKK KK KKK KKK KKK KKK KKK KE KKK 
* This file contains the execut 
% Erneonriandl 
*« 

* Algorithm : ErrorHandler() i 
= compiter, Lt 2a 
ts the* error iS wr 
* ErrorHandler() c 
* a known point in 
. recovery. Afte 
* betinnis “to. calla. 
x NOTE : ferrorfile' must 
* ErrorHandler() i 
* to last times er 
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* Modified 


* 


RK KKK KKK KKK KKK KKK KKK KKKKK KK 


tinelude <stavosn 
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PUBLIC DOMAIN SOF IWARE 


Capt J.E. CONNELL 


KKK KEK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK 


ion modules for error recovery. 
er(), EatEm() 


s called by other modules in the 
sures the error count is updated and 
itten to the “erron fae If required, 
alls EatEm() to gobble tokens to get to 
the parse. Used during error 
r MAXERRORS number of errors simply 
ng routine. 
have been initially created before 
s first called - don't want to append 


+ + + + + + + + FF F F F OF F F FF FE F OF F F 


rors! 

KKK KKK KKK K KK KKK KKK KKK KE KKK KKK KKK KKK KKK K 
* 
* 


KO RK RR RIK RR ek / 


#include <scanner.h> 
finclude <errors. A 
extern FILE *errorfile; /* WOEkKing sf mime “i 
Nahe num_errors = 0; /* running talley of # erors “7 
/« found = global var a 
enar “error sil )was{ /* array of error messages 7 
| coed 0 ee | " incomplete iso", 
eile ara " RESERVED FOR FUTURE USE”, 
Tere ay, wIN\!' without following ‘/', logicaleG@n tc. sa 
ees ay "'S* without following ‘R',°N >) "2. Sage eae 
on ahi y, "invalid numeric constant ==> "4 
yee lneit 4 "literal without ending =) 
1 aN <a ale) “unidentified char in input program ==> ", 
| a 27 f "MEMORY OVERFLOW DURING COMPILATION”, 
[2G a, "error in statement following ==> “™, 
eS Mad? | "error in type definition following ==> ", 
me ae "unable to complete definition of blockbody after keyword LET", 
Fhe © Re: "missing or misplaced ';' after definition", 
f= Cc =A "valid qualexp/exp not found in the def/auxdef", 
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/* 
j* 
/* 
/* 
J * 
/* 
/* 
/* 
jer’ 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
/* 
As 
/* 
j* 
/* 
/* 
/* 
/* 
/* 
Viel 
/* 
/* 
1 * 
7 = 
/* 
j* 
j* 
/* 


ie 


th DO 


7 Q 


Zs ©€ COUN HH OO OS 30 xe 


FF 
La 


sa 
KK 


}3 


Nrabid typeexp NOtwsouna in the def" 

Miormials s.istemissing Or Error in formals list", 
"misplaced or missing ", 

"at least one identifier must follow keyword TYPE", 
"unable to complete def/auxdef following keyword AND", 
"missing or invalid auxdef after keyword WHERE", 

"missing Or misplaced closing paren in formals list", 
"error in processing multiple Actuals", 

"missing literal after keyword FILE", 

"missing or invalid exp following KEYWORD ", 

"TF statement w/o ENDIF", 

"error in formals preceding |->", 

"missing or invalid QualExp following COMMA operator", 
torror Iie acootneing —scneck QualExp or closing bracket", 
"OZONE LEVEL I —- for 19.99 the feature can be implemented in 1999", 


i NUMERIC. VAGUE CEXPECTED 

eNALURAL EXPECTED *%, 

Y INTEGER GRY NATURALSEAPECTED “, 

VSR ROn iN CUE lE DEFINITION °, 

" UNDEFINED VARIABLE IN AND SCOPE ", 

“SP UNCEION WEliOut rUNCTION DEFINITION ."™, 
“ FORMALS MISMATCHED *, 

e FUNCEION CALLED SWITHOUT FUNCTION DEFINITION ", 
“REAL NUMBER EXPECTED ™, 

" INVALID CONSTANT EXPRESSION ", 

" BOOLEAN VALUE EXPECTED ", 
T—'BOULEANTOPERATOR EXPECTED ”, 

© OUT OF RUN-TIME MEMORY SPACE ", 


[RRR RK RK KR KK IK I RK RIK KR KKK KK I IK / 


void 
Beeoridandler (line no,err_no,str_num) 


ot en CR NOL pee sr 110%, 
long Str num; 
LS use long because str_num is either pointer to a string "long" */ 
ee or an actual number (int or long) * / 
{ 
#ifdef DEBUG 
images ( Ch entered, err# = $d, str num = %$ld\n",err no,str_num); 
tendif 
if (++num_errors > MAXERRORS) Retura, 
Eeeeorri le = fopen(“errors.phi", a"); /* append to what's there “iy 
men (err no == ERR?) /* no more memory - a7 
Memeorince(eCrrorfile,"ts\n",errors(err no]); /* get out and start over =] 
Sek ECEr () 
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execl ("rock.exe™, “rock.exe" / NULL) 
) /* end if no more memory 


forintilerrorftile, “line *2cmscmar 
line _no,errors(err_noj); 





switch (erzine) { 
case ERR4; 
case ERRS: fprintf (errorfile, “ts\n", (cham = )cemae ae, break; 
case ERR6:; fprintfl(errorfile,"%.1s\n", (Chaz sm ee 
case ERRS: switch (str_num) 
{ ‘case LEO. : fprintf (errorfile, "<=\n"; break; 
case NEQ : Eprintf (errorfile, <= ae, break; 
case GEQ : fprintf (errorfile; ">—- a break; 
case EO =m: fprintf (errortites — ca. break; | 
Gace: ADD ye. fprintflerrorflile, “aaa break; | 
case SUB_: fprintft (errorfile, sae break; 
case MULT : fprintt (@rroriile; == aie break; 
case IDIV : fprint£ (errorfile; “tn ie break; 
case RDIV_: FPrintt (errortite7 aie. break; 
case SUBSCRIPT : fprintft(errortite, ioe break; 
case ORLOG_ : fprintflernorfile,” V7 wae); break; 
case ANDLOG : fprintf (errertile, |) aa break; 
case NEGLOG : fprintf(errortile, .= aaa, break; 
case COLON : Eprintt (errorfiile oan we break; 
case CAT_ : fprinti(errontile.. = awe. break; 
case LINERTARROW_: forintfi(errorftile? | — > nae break; 
case (KW_+GREATER ): fprintf(errorfile, “GREATER\G |) ogodq 
ease (KWe- ENG) : fprintt (errortile, INwwae DrEeak; 
GaSe) (hNe= Ebsoe)s. fprintfilerrorfiile, “Eros waa. break; 
case (KW_+NOTIN ): Eprint£i (errorfile, “NOrii a), break; 
de fauEirs: ; 
fprintf (errorfile, (UNDEFINED error a 7 
} /* end switch case ERR =} 
break; 
case ERR9Q: switch (str num) 
{ case ADD_ ; Eprinied (@rrorti ler mae: break; 
case MULT_ : [Pprinttlerrorfile, ’=\nie break; 
case RTARROW _: forintf (errorfile,"=>\n")> break: 
case LTPAREN _: forintt terrortilerse.”)- break; 
Gefaud : ; 
Pprintft(errorfile, "UNDEFINED @rror in’); 
b /* end switch case ERR9 =} 
break; 
case ERR f: switch(str_num) { 


case  KWe-ANDS |. 
Case AW +WHERE ©: 

Eprintftlerrertile,"—=\n1¢ 

break; 
case RTPAREN : 

foringtierrerftiltes |) in ee 

str num=NULL; break; /* don"t want to go Eourawua oh 
case Risguiem. 

forint eierrorni ler an 2): 

str num=NULL; break; /= don't want tO gO oO Baan Be: 
case END SEQUENCE ; 

fprintt(errortile. > \ne 

SCE num-VUEL, rea, /* don't want to go to Eaake 4 
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ease KW TEND ; 
Eppa mbs(erroriile, “KEYWORD END\n") ; 
str num += KW _; break; 

case ekW tl HEN < 
Eerintert(errorftile, "KEYWORD THEN\n"); 
break; 


default: 
forint £(ecrrortile, “UNDEFINED error\n") ; 


} 
break; 


case ERR_m: switch(str_num) { 


cases lan 

Pemeiaee(errorrile."LP\n:) break; 
case ELSIF _ 

POrricoeverror rile, “ELSIE \n*)); break; 
Gase Plch 

Eprantrlerrorfile, “ELSE\n™); break; 
case THEN” 

PoOring: (e@rrort ile, “REEh\n™); break; 
Gase CEGCIND 

Eprinee (Grrorrtrile, “BEGIN\n')-; break; 
aerau le: 

EoOEIact (errorrile, “UNDEFINED error \n™) ; 
} 
Seo OUmet— KiNG, 
break; 

Geral ts Eprints’ (errorftile, * A oad 


merose(eCrrorlti le}; 


if ((err_no >= ERR_a) && 
(Gri nO < “ERR aa) <6 
(str num != NULL)) 
Pacem teat) str num); 
} 


/* 


/* 


/* 
/* 


/* 


fees 


Set Uupetor. call Lokatem 


/* end switch case ERR _f 


end switch case ERR_m 


S€uestraesum up to De passed 
to EatEm() 


end switch 


end ErrorHandler 


a 


“| 


td 
as 


ae 


© 


[RRR KR KKK KKK KK KKK KKK KKK KK KKK KK KK KKK KKK KK KKK KK RK KK KKK KK AK KKK KR KK KK KK / 


void 
Bae em (tot) 
mat tot; 


Mmemimerements token buffer pointer until tgt token is found. 
/* Use in error recovery to reach a known point in the program. 


{ 
extern LOaG EOKGNDUELEC |; °* Er; 
extern ae line no; 


#ifdef DEBUG 
Drinti("eatem entered, tgt = td\n",tgt); 
#end1ift 


wiile(*potr != EOF) { 
SWereh (tat) 
iS case EOLN _ 
++potr; ++line no; break; 


eases obi 
if((*ptr==SEMI_) [| (*ptr==KW_+LET_)) 
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mi 
Bah 


return; 
eh OL rs break; 


case EQUIV : 


{ case 
case 
case 
case 


EQUIV_ 
SEMI _ 
KW_+AND_ 
RVs oe 


default: 


} 


case KW 


{ case 
case 
case 
case 


break; 


+WHERE 
KW +WHERE_: 
KW +AND_ 
KW +LET_ 
SEMI_ 


default 


} 


case ke 


{ case 
case 
case 


break; 


+AND_ 
KWOSAND _ 
KWe one 
SEMI _ 


default 


} 


break; 


case RTPAREN_ 


{ case 
case 
case 
case 
case 
case 
case 
case 


RTPAREN _ 
LIPAREN 
COMMA _ 
EQUIV_ 
LINERTARROW ; 
KW +LET 
KW_+AND_ 
SEMI_ 


default 


} 


break; 


Cas enka airs 

Case lene ouster | 
case KW + ELSE 
case KW + THEN _ 


{ case 
case 
case 
case 


KRWet ELSIE | 
KWiot ELSE | 
KW + ENDIF_ 
KWet THEN 


_ Oe, break; 


case COMMA _ 


{ case 
case 
case 
case 
case 
case 
case 
case 
case 
case 
case 


COMMA _ 
LTPAREN _ 
RTPAREN_ 
LTSQUIG_ 
RTSQUIG | 
ST_SEQUENCE_ 


END SEQUENCE : 


SoM be 
KW_+LET_ 
KW_+WHERE | 
KW_+ AND_ 


default 


switch ((int) = per 


return, 
DEG, 
/* end switch Case EQUI 


Switen (int) eer 


reLurcn: 
bos) ® Bae 
/* end switch case WHERE 
Switch (tine) pew 
return; 
++ptr; 


/* end switch case AND 


switch (€(int)=per) 


FeEUrn: 
FTDCL; 
/* end switch case RTPAREN 


Swileent (1 ae ols) 


return; 
/* end switch case THEN, etc 


SWiten (Cnt? pes) 


return; 
- Oia, 
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} break; 


ease KWeTEND 

case KW +BEGIN _ 

Were asehWereND 
ease  KWeTLET | 
case KW +WHERE | 
case KW_+AND _ 
ease COMMAT 
case RTPAREN _ 
Gace RT 2OULG 


e 
e 


case END SEQUENCE : 


Case, SEMia 
default 
} break; 


default 
return. 


} 


/* 


Svmeemet (int) *ptr) 


return; 

+r DeEr, 
/* 
/* 
/* 
/* 


end switch case COMMA 


end switch case BEGIN/END 


end swithch 
end while 
end EatEm() 


as 


a 
ay, 
“as 


[KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KK KK KK KKK KK KKK KK KK KK KR KK KR KK KK KR KK KKK IK / 


WO 


APPENDIX J 
ROCK COMPILER — SEMANTIC CHECKER 


[RRR KKK KK KKK KKK KKK KK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KK KK KKK 


PUBLIC DOMAIN SOFTWARE 

Name : Semantic Checker Module 0 

File >; SemdQ.c 

Authors > Maj E.J. COLE / Capt J 78 seein 
Started 2 201 87 

Archived” 39 5047 0is7 67 


Modified : 


KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK 


This file contains the following modules for the PHI parser: 
Hnumconvert Numconvert 


AVG orice: 

This module contains procedures for type conversion. If the 
rt child of a node may be converted to the lt type but the con- 
* verse is not true, "Hnumconvert" is called. If either side may be 
* converted, "numberconvert" is called 
KKK KKK KKK KKK KKK KKK KK KKK KEKE KK KKK KKK KKK KKK KK KKK KKK KK KKK KKK KKK KKK KKK KKK 


* Modified : ‘ 


KKK KKK KK KKK KK KKK KK RR KKK KK KKK KKK KKK KK KKK KK KK KKK KKK KKK KKK KK KK KKK RK KK / 


+ OF Ob OF OF OF OF OF 9b ob OF OF ot Om Se 


+ + + + + OF F FF F OF F HF OF OF FF F 


[RK KKK KKK KKK KKK KKK KKK KKK KK KKK KK Externals KKK KKK KKK KK KK KKK KK KK KKK KK KK / 


*include <semcheck.h> 


extern void Cerror t)) 
[EKER KKK KKK KKK KKK K KK Anumconvert KK KKK KKK KKK KKK KK KKK KKK KKK KK KK / 
PH. PE 
NNUMEORVEr to Leype TL ype, Stir) /* Type conversions for the “7 
/* right side of the tree only “7 
PHITYPS leype, reyoe: /* Left and Right types +4 
nedaliiptr- /* Ptr to the root working 41am “7 
(Gx0ern Vole (ZEor. (); /* Generates code to convert <7 
/* integer/natural to real “ 
1£ ((itype == BOOLEAN) && (rtype == BOOLEAN) ) 
return (BOOLEAN); /* No type conversion needed =i 
switch (ltype) { /* Predicate actions on tyoe Olgas 
case (REAL) : switch (rtype) { /* side of node 7 
case (REAL) : return (REAL); /* Matching types; no conv req “7 
case (INTEGER) 
case (NATURAL) : /* Generate code for conversion ~yi 
Geclor (i; 
return (REAL); 
default 


liZ 


EGrEOreERR: dd, cCr=- _n)y 
return (READ } 
case (INTEGER) Switchmreype) 
case (INTEGER) 
case (NATURAL) return (rtype); 
default 
Cerupr(eRR ce, Ptr=sin) 7 
return (INTEGER); } 
case (NATURAL) 
if (rtype == NATURAL) 
Perum “(Ee ype), 
else { 
Eerror (ERR bb, ptrs7ini= 
return (NATURAL); 
} 
default EGrpLOr VERB Udad, otr=> in), 
return (NATURAL); 


j/* 
/* 


No appropriate match; error 


« 


Rtn real so semantic check cont?” 


Matching types, no conv req 


Can't Goenvert from real to int 
so sandbag the programmer 


Only one match poss w/o error 


[RR KK RK RK RRR RK RK OR RK KK EK Numconvert Ka KK KKK KK KR RK RK RK KKK KK RK KK KK / 


PHITIPE 
numconvert (ptr) 

Roda! ptr; 
{PHITYPE ltype, rtype; 
extern PHITYPE semcheck (); 
extern void c ztor (); 


ltype = semcheck (ptr->lptr); 
1f (ptr->rptr->name == (KW_ + ENDIF _)) 
Eeturn “GLeype) } 
Beyoe = semcheck ({(ptr->rptr); 
if ((ltype == BOOLEAN) && (rtype == BOOLEAN) ) 
return (BOOLEAN); 
switch (ltype) { 
case (REAL) switch (rtype) { 
case (REAL) return (REAL) ; 
case (INTEGER) 
case (NATURAL) 
EEZEOE(); 
return (REAL) ; 
default 
COreGmNCERR da, PEr—>rper->1n); 
return (REAL); 
} 
case (NATURAL) Switch (rtype) { 
case (REAL) 
GReuor |); 
return (REAL); 
case (INTEGER) 
Return -GINTEGER); 
case (NATURAL) 
return (NATURAL) ; 
default 
Porro pw ORR wad, OC r—>rper—>in); 
return (NATURAL) ; 


Ns 


f= 
/* 


7 = 


/* 


/* 


/* 


Do number conversions for 
both left and right side 


Left and right child types 


Get left type 
Special case of "if" sequence 
Get right type 


No conversion necessary 


Predicate actions on lt type 
Types are same; no action reg 


Generate» code for ancy nat 
to real conversion 


No converison possible 


Convert left side 


No conversion necessary 


No conversion necessary 


ae 


ays 


es 
ah 


ef 


an 


av 


ef 


ces 


tf 


a 8 


sia 
aa | 


sr 


a 


ed 


ay. 







case (INTEGER) : switch (rtype) { 
Case (REAL) : /* Convervasle: stems 
CUZEOr ey 
return (REAL); 
case (INTEGER) : 
case (NATURAL) ©: 
return (INTEGER) ; /* No conversion necessary 
default ;: | 
Cerror (ERR aa, CPeG= > rpereo En). 
return (NATURAL) ; 
} 
default 
CGrror (ERR oe, ees -- lpr —> laye. /* Types are not numeric 
return (NATURAL); 
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a EKER REAR RAKE KERKEKKEKKKEKKK © 


* PUBLIC DOMAIN SOFTWARE x 
* * 
* Name : Semcheck Module 1 * 
* File — 7 ceml.¢ : 
* Authors Ma Ee meOlrmy capt J.6. CONNELL 
Zeotareed ood 7 027/57 * 
meArenaved 9: 01/10/87 x 
* Modified : * 
KKK KKK KKK KKK KKK KR KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK 
* This file contains the following modules for the PHI parser: - 
* * 
. Tletdef TrtaLerow Tkindef : 
x Twhere Tdataauxdef Tauxand x 
i Tandcheck Tauxand TEyeperimnes x 
* * 
SeeLGOritam : * 
* This module contains scoping procedures (Twhere and Tauxand) - 
* definition procedures (trtarrow, tkindef, ttypetimes) and the data * 
* definition procedure. * 
* * 
KK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KK KKK KK KKK KKK KKK KKK KKK KKK KKK KK KKK 
* Modified x 
Hee kek Kk Kk I eI I KI I I I III FI tek KK ee tek ee / 


[RR KKK RK KKK KK KK KR KK KK ek eK Kk Externals Fe kek ee kek kk tek kK kk ke / 


#include <semcheck.h> 


#include <string.h> {/* On St repy. ard 
extern int typeptr; * Typetable and pointer eA 
extern tnode types []; 
Seeerm void terror (); 


fnode *fhead = NULL; 

| O% R&R ee eke ee kek Tletdef wk kK kk ke / 
void 

tletdef (ptr) /* checks types of both branches */ 
mogdal ptr; 


semcheck (ptr->lptr) 
semcheck (ptr->rptr) 


“es %e 


[O&K RK I I I IK IO kk Erte arrow KKK KKK KKK KKK KKK KK KK KK KK KK / 
PHITYPE 

metarrow (ptr) /* Returns type as 
nodal ptr; 

Bea TYPE ltype, rtype; 


excern vOold putform (); 
ltype = semcheck (ptr->lptr); /* Check left side type =/ 
rtype = semcheck (ptr->rptr); /* Check right side type ay 
mei) (ptr—>lptr->name == TYPETIMES) | | 
(per—>lptr—>name == TYPEPLUS) ) 
putform (ltype); / On ey sree rL node not. “Yor 'r'* / 


metcurn (rtype) ; 
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[RRR RRR RR ne Teingdeat KK KKKKKERE KEK KK RRA KRK KX KK RK A 


void 
tkindef (ptr) /* Adds variable name to defstacx */ 
nodal ptr; 
{extern defotr defhead; 
extern void pvoutdef (); 
PHITYPE rtype; 
rtype = semeheck (eera> cee); 
putdel (re Vvoe,) per —> ioe) /* Put definition in detstaen 7 
defhead->fptr = fhead; /* Append formal types to entr “7 
fFhead = NULL; /* Kill fhead x / 
} 
[ERK KKK KKK KKK KKK KKKKK KKK KK Twhere KR KKK KKK KKK KKK KKK KK KK KK KK KR KK KKK / 
PHITYPE 
twhere (ptr) /* Semcheck where node 7 
Nodal oer; 
{(PHITYPE type; 
semchecker (ptr->lptr) ; /* Check Wefteside x / 
type = semchecker (ptr->rptr); /* Check right sade ay 
return (type); 
[ERK KKK KKKKKKKKKKKKKKKKK K TDatauxcaer KKKKKKKKKKKKKKKKKKKKKKK KKK KK / 
void 
tdatauxdef (ptr) /* WORKS FOR ONE FORMALS ONLY 7 
nedal ptr? 
{extern void c_ store code (), c_jmp (); 
extern PHITYPE getdtype (); 
extern defptr finddef (); 
extern char *name (); 
des pcr caper: 
char *nolder°="malloee"(8)., /* Temp holder for function name */ 
*nme = malloc (8); 
PHITYPE rtype, /* Type of left and right nodes ee! 
type, /* Type of datadef ee 
County —-.0, 
nme = Strecey sinme, mame ())- 
c_ jmp (nme); 
holder = strepy (holder, name()); /* Calculate function name 7 
¢ start proc {holder); /* Gen code for starting proc 47 
rtype = semcheck (ptr->rptr); /* Get type of righteeens <7 
if (ptr->lptr->name == IDENTIFIER ) { /* Open can of worms to typecnheckue? 
/* if lett aseidenee Bo 
Let (de per=ftinddel (ptr->1lptr->index) jm, /* No prev decl of this variable 
pEr->lptr-Stype = rtype-; 
PucCVar (LEVpe, > pero Der); 
} 
else: if (d per-> pte rrs= NULE) 4 /* Prev decl of var is data def “7 
PES IPEr=stype = getdrype (auper, 
type = Anumconvert (ptr=>lptr-Styoe, 
rtype, ptr); /* Convert rt type if feasible a7 
PuUCVarL Mik Voce, per > lpr, 
} 
else /* Prev decl of var is another var*/ 
terror (ERR=dd, ptr->lptr— sini 


} 
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while (*(holder + count) != NULL) { / Sesne plano theougn the door zy 


i CO COpY surincs 77) 
Geer-=lptc—> label [count!) = (~{(holder + count) ); 
++count; } 
¢ store code ("ret\n"); /* Generate code to end procedure */ 
c store code (nme); /* CANNOT USE C_END PROC () HERE; */ 
7 S /* NO SCOPE CHANGE! «/ 
epstore code (:\n"); 


} 


eee RRR KR RAK KKK KAR KK EK And Check KO Oe / 


void 
and check (mark, ptr, mark_and) /* Check and list for var defs 7, 
waGptr Mark, /* Scope delimiter a 


BGepece Mark and, ptr; 
{extern varptr varhead; 
Sxeer teint OUEPeptrs 
pxeerueciar ~code buffer; 
moe Ourt holder; 


Meanoer VY PL = vyarnead; 

Pemcper |= NULL) { /* Ptr = NULL is base for recurs */ 
and check (mark, ptr->link, mark_and); J/% OF -angveneck x / 
eo 4 /* Loop to evaluate all prover aed 

/* varptr entries st 
/* Check if equal names in s/t 
{/* andes & var list oy 
J" NOt a LUMeELoON definition ei: 
ee (Vooper-snptr->index=—=pLr->ptr->index) { 
buff holder = buff ptr; /* Save code buffer pointer arf 
DUE Ours pcE--buUETpLr; /* Get location of variable code */ 
Cmca maproc (VY per onplr-=> label); (] SGeVerace coce ar 
buff ptr = buff holder; /* Restore buffer pointer ay 
Pas mab. and == ptr) /~ Traverse list 7 
emack. and = -ptr=>link; 
delpanas( ptr); 
break; } 
if (v_ptr == mark) break; /* End of var list reached ae 
VeaPeG eve pcr—> link; 
} while (TRUE) ; /* Exit is accomplished using a ay 
/* break in the loop wes 


[RRR KK RR RK kk ek Tauxand FIFO IKI IO IK Rk e / 
wold 

jmeuxana (ptr) /* Semantic check for and node a 
modal ptr; 

{extern FLAG and flag; 

eeecrn and ptr and head; 


int save_and; /* Holder for and flag ae 
menrocr mark; /* Mark top entry in the varlist */ 
ana ptr tptr, mark and = and_head; /* Mark current neaa of and stack */ 
save and = and flag; /* Save current and flag ie 
and flag = TRUE; /* Set and flag i 


Ply 


semcheck (ptr->lptr); 
mark = varhead; 
semcheck (ptr->rptr); 


and_ check (mark, 


and tlag7— savesand, 


tptr = 


while ( 


and head; 


tptr != NULL 


and_head, 


Cotr = cpetr-> link; 


LEwindrk tana 


terror 


[RRKRKK KK KKK KK KK KKK KK KK KK KK KK KKK 


= anes head) 


(ERR ee, ptr=>ln); 


PHITYPE 
ttypetimes (ptr) 
Nodal. oer, 


{extern vol 


ad-Suctorm (ne 


PiublVves cyoe, 


(semcheck (ptr->lptr)); 


pucftorm 

if (type = semcneck 
putform (type); 
FPekUrns(NUE ae. 


(BEr-2rper)) 


&mark and); 


/* 


f= 


{/* 


/* 


/* 


Semantic Cheek 


Check all new fctn & data defs 


Restore and flag 


Traverse list untzivene 


Undefine variables found 


eo 


7 


7 


“7 


"7 


TTypeTimes OK OK I / 
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/* 
/* 


/* 
/* 
/* 
/* 


/* 
/* 


Semantic check '*' when used 
for types 


Attach formal type to 
formal list 

Look for right type; Demag 
end of insertions 


Always return NULL; 
This value is used Dy Carers 


ee 
+7 


"i 
"7 
“h 
7 


<7 
7 


ee rg eI REE AER ARAK RK KX RRAKRARAKKKKKKKKRKKK KKK E 
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+ 


* 
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PUBLIC DOMAIN SOFTWARE 


Name : Semcheck Module 2 

File > Sem2.c 

Authors onl ow cClne, —capt J.-E. CONNELL 
Started wee 02/37 

Archived : 04/10/87 

Modified =: 


This file contains the following modules for the PHI parser: 


Matchfor T£unauxdef Pewn1 
Mae rua best hatte Act_Walk 
Telist 


Polgore act hm 
This module contains the procedures needed to define and call 


functions. Tfunauxdef will set up the run-time structure of the fun- 


Seton, ccunia will check the semantics of the function, & matchfor, 
called by tfunid, checks for the proper type & number of formal pa- 
Pane te is . 

Tactualist coordinates the checking of a function call. It uses 
both telist and act_walk. Actwalk determines whether the number & 
type of actuals is correct, and telist checks each element list and 
returns its type. 

Tid performs semantic checking for program variables. 


* 


* 


+ + 


* 


4% + + + + £ * + € 4 HF * FF 0H FF HA H HH FF HF HF *F 


KKK KEK KKK KKK KKK KKK KKK KKK KKK KKK KEK KKK KEK KK KKK KKK KKK KKK KKK KKK KKK KKK 


* 


Modified =: 


* 


KKKKKKKKK KKK KR KK RK RR KKK KK KK KKK KKK Kk KK kK kK RK KK / 


[ERK KKKKKKKKKK KKK KKK KKK KKK Externals aR KR RR KK KR KKK KKK KR KR KK RK KKK / 


#include <semcheck.h> 
menclude <string.h> COG “St neo 


extern tnode types []; 
extern varptr varhead; 
Bee 1) VOld terror {), ¢ store code (); 


[RRR KKK KKK KKK KKK KKK KK KK KK KK 


Mae actual count = 0; jeecount Of allwactuals 


[KKK KKKKKKKKKKK KKK KK KKK KK KKK 


FLAG 
Sacentor (nptr, def) J eoMaten Lorumals 
Poe calteadepy (runic  Goasonly 
modal nptr; (PLE LOsGeeSiGe OL .unid node 
defptr def; /* Ptr to var table for func name 
mexcern long curr addr; 
meeerm £Enode *getfptr (); 
extern FLAG form; /* Flag set when formals 


fnode *tptr = ge 


/* are generated 
(def); 


ct 
th 
ae) 
=e 
im | 


form = TRUE; 
meer = det->f{ptr; 
eurr addr = 0; 


ly 


Bes 


Globals KKK KKK KKK KK KR KKK KR Rw / 


of 


Matchfor KKK KEK KK KKK KKK KKK KKK KK KK KR KKK KKK / 


a 
x 
et 
‘7 


i€ (nptr->name == IDENTIFIER) { /* Only one formal «/ 
(NPtr=>type) ="Uptr=>eyce, 
Nptr=>saddr = curr acer, 
pUtVar (Eptr—otyre, NEF), 
APC =TNpess epee, 
Eptr = €per-sian, 





else { /* Multiple formals x/ 


APCE—-2 DEL. ey pe EpEE—>type; 
NPUras2 i ptr=>adar #=scurraacar., 
CULT adcr = CUrrsaddr. 
types [tptr->type] .bytes; 
PULVar (Lolr-2tvpe, Apir—>lorm; 
APCr — Nee r—sEper, 
EDtCr “= Jtptr—> lia 
} while ((nptr!=NULL) && (tptr!=NULL) ); /* Halt when end reached iH 
/* by either ptr = 


form = EALSE: 


Lf (nptr J] NULL OIE tear. ! = NUE) /* One ptr isn't at end Of <7 
return (FALSE); /* Error handled in calling teem 


else return (TRUE); 


[RKKK KKK KKK KK KKK KK KR KKK Tana eae c KKK KK RK KKK KK KK KK KK RK KR RK  / 
Vong 

tfunauxdef (ptr) /* Type check funauxdef air é 
nodalsSra, 

{extern long curr addr; 

G@XCeErn VOld erend or6oc: (),7¢) Imp Ue: 

extern char *name (); 

extern nodal KAnumconvert (); 

char *nme = malloc (8); 

PHITYPE ltype, rtype; 

varptr varl, mark = varhead; 

Fong pres addr) - cure saddr,; 


nme = strepy (nme, name ()); /* Name for jump around function */ 
c jmp (nme); /* Gen code to jump around tegm ee 


ltypope = semcheck (ptr->lptr); 


rtype = semcheck (ptr->rptr); 
while (varhead->link != mark) { /* Eliminate formals from Ink eeeceee 
varl = varhead; 


varhnead = varhead->link; 
varl-~>link = NULL; 
free (varl); } 


ptr->rptr = /* Convert if needed “7 
ANUMEONVeErt “{ltype, Ltyoe, per—-srotr7 


Cc eng proc (ame); 


curr addr = pres_ addr; /* Reset addresses “7 
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PX KARR KEKKAKKK KE KEK AKXKKE evi eect RRXKKRKKKKKKRKKEKKKKKKKKKKKKKK KKK / 


PHEry PE 
Peunra (ptr) .. /*ssemantic Check for tfiunid x / 
nodal ptr; 
{extern defptr finddef (); 
extern long curr addr; 
extern char *name (); 
int count = 0; /* Generic loop varient = / 
defptr def; 
char *holder = malloc (8); 


Peme(aet = fLindder (ptr—->lptr-—>index))) { /* Func name not found af 
GeraCmmveORR@EE PCr =>in je 
return (NOTFOUND); } 
else { 
ptr->lptr->type = def->type; /* Set node type au 


ptr->type = def->type; 
Putvar (ptr—->lptr->type, ptr->lptr, FALSE); 


hen ( maceciron  (olbr—->rptr, def) } {© Match, formals * / 
ECrsOm ERR. 9G,, ptr—>in); 


else { 
holder = strepy (holder, name ()); 
while (*(holder + count) != 0) { /* Push piano -> door to copy =] 
J/* SEEING to array <7 
(otr->lptr->label [{count]) = 
(eo (netder er count) ) ; 
++count; } 
per->lptr—saddr = 0; 
Smstart proe (ptr->lptr->label); /* Gen code for begin function = 


) 
} 
Feturn {ptr->type) ; 


RRR AKKKKKKKKKKKKKKKKKKKK TOLLISE FKEKKEKKEKEKKKHKKEKKKKKKKKKK KKK KK / 
void 

telist (ptr) /* Semantic Check for element lst */ 
medal ptr; 


men(ptcr—>rptr != NULL) /* Only semcheck if there is ae 
/* something there =/ 
Semeneceki(plr—-srptlr); 


semcheck (ptr->lptr); 


Sescere code ("call ppop\n"); /* Generate code mie 
Seseore code (“push cx\n"); 

Beoaeore code ("push di\n"); 

@-actval Count; 


[RRR KKK KKK KKK KKK KKK KKK KK KK KK Act Walk KAKKKKEK KEK KEK KK KKK KKK KK KKK KK KK / 
void 
Serewalk (ptr, fptr) /* Recursive procedure to lh 
J=esem eneck actual Jist a 


Ta 


Noga la ptm, 
EnoCce ss et Ea, 


if (etl =FEper == er) /* Recurse until NULL ptr JS )iieeee 
act walk “(ptr->ppte, fpr con a, 


semcheck (ptr->lptr); 


iL£ (ptr->lptr->name != ELLIST) { 
++actlaiwecounu, /* Iner count only 16 tege *7 
/* sibling is anene =i 
¢ steremeode | “calle ppep iad, /* Generate code to put addresses */ 
/* On the  suaer xf 
GC Stone (code (pus imeex ig), 


¢ Store code (">ushrat\n 
} 
} 
[RK KKK KK KK KR KK KK KK KK RK RK RK KK Tactuals KOR KK KK KKK KK RK KR KR  / 
PHITYPE 
taccUa ls “(pro /* Evaluate actualists 77 
nodal. ptr: 
(extern vole crcalisproe.(); 
extern FLAG and_flag; 
extern varptr findvar (); 
extern defptr finddef (); 
extern char *name (); 





defotr det = finecer mirc: —> ll prr—>incex, - /* Defstack pointer il 
varptr var = findvar (ptr->lptr->index); /* Varstack pointer x7 
Int count Node = ac ua lecoun., 

char *long buff = malloc (10); /* Buffer for long to string meen 
Long Convert; /* Conversion variable 7 


=hOGce *lpur; 


actualecount. = .0; 
be 4GGL) a /* Definition found “7, 
PE a vara sane ve lag) Wie vaEr) /* Legitimate cases 77 
{ 
Eptr — cCer—-fptr;: /* Get a ptr to the formal nedes aa 
act Walk (ptr senre sn tore), 
convert = “actual count; 
¢ store code ("mov bx, "); /* Generate code to put # of bs! 
/* actuals on the stack ty 
stella (long butt, convert) ; /* Long to string conversver =f 
Grstore code (long 5uft),, 
estore code ("\n") >; 
Cgecat Proc ("emo"); 
UE “(tand flag) seat var )) if /* Cover "and" scoping rules 7 
add ane = (pire > leer); 
cheativerce (mame ()); /* Holder fox reaieaag. 4 
} 
else 
e Call proc (var->nptres lace, /* Gen code to call tuncerog =f 
actual count = count_hold; /* Restore acttalecouge “7 
return (Ger -eyvpes; 
} 
} 
terror (PRR van, ptre>in); /* Function, name not foun =f 


return (NOTFOUND); 
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RR KR RK KK KAA RAKE KKK KK KX Istiel 


PHITYPE 
tid (peu) 
nodal ptr; 
Wexcern vold € igsform (); 
extern long curr addr; 
extern char *name (); 
excern ant formal. (); 
extern FLAG and flag; 
extern Varptr findvar (); 
extern defptr finddef (); 
char *long buff = malloc (10); 
Weatoer Var = findvar (ptr->index) ; 
defptr def; 


io vac) { 


mee (det = finddef (ptr->index)) { 
Pee(anastlag). { 
add wands (oer) ; 
C@-oe ep oc (mame —())] 
return (getdtype (def)); 
} } 
else return (NOTFOUND); 
} 


else if (formal (var)) { 


Svermemrong Dull, Var-enptr—-addr); 


emrerorm (long butt); 


} 


else 


Grea epsoe (var—snptr—-> label); 
a, 


return (getvtype (var)); 


wR KK KK kK ee / 
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/* Typecheck Id node 

J* Burren sommrong tO string conv */ 
;* LOOK EORwaetinition Of var ae 
/* Rtunweype Lf var found af 
/* in def table «/ 
/* Get and return type definition */ 


Long to string conversion ar 


T& no formal List, assume var .*/ 
ls an assignment sa 
Generate code to call proceaure 


to assign value 8 
Return variable type ae | 


[RRR KK KER KEK KK KK KEKRKEKKKKKKEKKKEKKKEKKKKKKKKRKKKK KKK KAR AR ARK AK AAR A eee 


PUBLIC DOMAIN SOFTWARE 


Modified : 


Algorithme: 
arithmetic & boolean operators. 


on the operator type. 
for real “© “Ant veivision, 
ops, the numconvert procedure 
tic checking, 

For each boolean operator, 


In addition, 
Galling convert, 


+ + + 4+ 4+ + + 4% 4 + + + + FF F + FF HK FF FF FF FE KF HF FH 


* 


respectively. 


Name > Semcheck Module #3 

File 2 Sem siac 

Authors >: Maj E.J. COLE / Capt J.E) Conn 
Started : SCayw27 s7 

Archived : 04/02/87 


keke kkk kek Ke KKK KKK KKK KKK KKK KK KKK KR KK KKK KKK KK KKK KKK KEK KKK KKK KKK KKK KKK KKK 


This file contains the following modules for the PHI parser: 


Trdivide Tidivide 
Tprimary Tconvert 
Tand Tor 


This module contains the procedures necessary for implementing 
Tarithop coordinates the semantic 
checking of arithmetic ops by calling the proper function based 
Trdivide & Tidivide handle semantic checking 
For all other arithmetic 
(sem0)is called to perform seman- 
then code is generated. 
the appropriate child(ren) 
and code is generated for the operation. 
tconstant checks the type of a simple constant by 
& then returns either the constant type or an error* 


Tarithor 
Tconstant 
Tnegation 


is checked 


+ + + + & & £ HH HF & £ FE FF H HH FE FF FE FE FF FE HF HF HF 


* 


KKK KK KKK KKK KK KKK KKK KK KKK KK KKK eK RK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 


~-~ModLE tea ae: 


* 


KaeKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK 


[RK KR RR KR RR RK RK KK eK Externals ROK KK IK Ik kK kk ke ek / 


include <semcheck.h> 


finelude <string> /* Foro strenew: i? 
GXtern VOld error () 
ExXCErn Void ¢ Seore code :(); /* Store asm language OUutEUE “7 
/* to d DuEte “7 
[KK III KI kk kek Traivide Re KR KK I I OR OK ek Ke / 
void 
Eraivide= (ptr) /* Division of real operands “7 
nodal. per; 
{(PHITYPE ltype, rtype; 
Qxtern, FLAG err sround, 
extern VOle "er Z LOLs) 7 
ltype = semcheck (ptr->lptr); /« Check left side for eyee “7 
switch (litype) { /* Make convs or locate errors at’ 
case (REAL) : Dreak; 
case (INTEGER): 
case (NATURAL) : 
C Zeon); 
break; 
default terror. (ERR aa, ptr=>ietce2 in /* Lt child must rtn numeric tyoeuam 
return; /* Error, no need to go thru acogeas 


} 
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reype = semcheck ({ptr->rptr); 
switcn (rtype) { 
case (REAL) 
case .(INTEGER) 
case (NATURAL) 
Src eOrEN().; 
break; 
default terror 
return; 


break; 


(SRReda pe pecs >rper=>1n); 


acode (ptr, REAL); 


) 


/* Check right side for tyre 


f= ELLOr, 


i —Generace coace 


[REKKKKKKKKKKKKKKKKKKKKKKR uwavellsalrel= KKK KKK KKK KK KKK KKK KK KK KKK KR KK KK / 


PHLEY SE 
meuaivide (ptr) 
nodal ptr; 
{PHITYPE ltype, rtype, type = NATURAL; 
ltype = semcheck (ptr->lptr); 
rtype = semcheck (ptr->rptr); 
Switch (ltype) { 
case (INTEGER) type = INTEGER; 
case (NATURAL) :break; 
default Po maoum@Onkk CC, ptr=>iptr->ln) 7 
return (INTEGER); 
) 
Switch (rtype) { 
case (INTEGER) type = INTEGER; 
case (NATURAL) break; 
default Peimon (Snnhecc, Press 7hper=>in), 
PecruUrn ( INTEGER); 
} 
acode (ptr, type); 
return (type); 


/* Semcheck for integer division 


/* TypeCheck both sides 


(= Cheek ile for InG/Natural Type 


(eer HOt Uinitwonr Nat... error 


P*Cneck-rt. for Int/’ Natural type 


{ie not uint Or Nat seerror 


/* Generate code 


[RK KKKKKKKKKKKKKK KK KKK KK KK dyeGenl eiqe) oc: Kak KKK ARK KK KKK KK KK KK RK KK KKK / 


PHITYPE 
@richop (ptr) 


modal ptr; 
pexcern PHITYPE numconvert (); 


int type; 
SWitch (ptr->name) { 

ease (ADD) 

ease (SUB ) 

case (MULT ) if(type = numconvert (ptr) ) 
acode (ptr, type); 
return (type); } 

else { 

DemecmeanthRoad, ptr->1n)? 
return (NATURAL); 


) 


y= Type Check Addition, 
/*" Multiplication, Sequence Ops 


J POSTE LON Lalhs. Through 
(/*Seuberactionm falls through 


NO Neecsto go Chru acode*!) 


a7 


a 


arf 


a 


4 


x / 
= 


er 
af 


case (RDIV_) trdivide (ptr); 
ptr->type = type; 
return (REAL); 

case (IDIV_) tae 1 Ge. pibiny, 
ptr->type = type; 
return (INTEGER); 

case (COLON ) brea, 

case S(CAT a) break; 


} 


/* Dummies for now, 
/* but watch our smoke!!! 


Ps x «COS ts 9 


[RRR KKK KK KKKK KKK KK KKK KKK KK Tprimary KKK KKK KK KK KKK KKK KK KKK KK KK KK KK / 


PHITYPE 
CoOrimary = (per) 

nodal ptr; 
(PHITYPE type; 


ctype = semcheck (ptr->rptr); 


Lf f= INTEGER) 
REAL) && 
l=" NATURAL) 


(ERR da, PEr—->rptr— >in); 


((type && 
(type 
(type 
terror 


t= 


else if ((ptr->name) == NEG ) { 
c_ store code ("call igetvalue\n"); 
G SCOre coder ( nedrax in), 
Gc store code (“call iputvaluexn"); 
} 


return (type); 


[RK KKKKKK KK KKK KKK KKK KK KK Convert 
PHITYPE 
GCONVEre. (SLEIIG) 
SiG) iSuring; 
{FLAG e = FALSE, 
period = FALSE; 
int count = 0; 


“FALSE™) 
PIRUE) y eet 


LE ¢ (st rempi 
&& strempi 


GS ein. 
(string, 


t= 0) { 
lLeount.))) 


While (string (count | 
tf el iseigit< (String 


De 


——_ 
== 


8 ee, 


pons am 


(string 


Leounc, 
(string = 


[count } 
if (e) return 
else { 

e = 


(ERROR) ; 
TRUE; 


LE (isiring (counter) 
(string [count + 1] == 


EFeCoOunc, 


/* Handle unary "*' or og 


/* 
/* 


Check type of right node 
Type must be a number 


es 
T* 


Negate operation 
Spew code 


/* 
/* 


Note that no action is req 
FOr Whar). 


KK KKK KKK KKK RK KKK RK KK KK KK Ke / 


Vo 
/* 
Fig! 
/* 
= 
/* 


Convert const to real, 
or integer value 

String to -eoenverc 

True if "e“ or “EM Srede 
True if a period has been read 
Garden variety loop counter 


boolean, 


/* If not boolean 


/* 
l= 


Loop until end of stiramag 
If character is not a duis 


/* “e" or "BE" fond 


/* Cannot Nave two "a7 


fx "4" or "=" Gharaceen 
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“7 
“7 
“7 


“i 


“7 
a 


“7h 
a / 


= 
=) 


ar 
“7 
a7 
wee 
bf 
ies 


gi 


a 





Eice ie (St ringwheount | ==". ") { 7 * Decimal point found = / 
if (period) return (ERROR) ; /* Cannot have two periods « / 
else period = TRUE; 

} 


else return (ERROR); } 
PH COUnE ; } 
if (e || period) return (REAL); /* If gauntlet has been run, =f 
/* pPerlogrles. ec" makes real =/ 
Meese ning (Oj—— =") return (INTEGER) ; /* Negative sign maxes an integer */ 
return (NATURAL); } (it no obneze num types, natural */ 
EeLturn (S0OLEAN) ; /* If not a number, a boolean ey 


[KKK I KI IORI II III IO KIO PCONST ANC © KK IR IK IR I IORI IO I IR I / 
PHITYPE 

meonstant (ptr) /* Handle constant nodes a f 
mocal ptr; 

{extern put_addr (); 

PHITYPE type; /* Constant type x / 

NameRec *tptr; /* Constant name x / 


peer) = per—->index; 


if (type = convert (tptr->name + 1)) { /* Calculate type =/ 
ptr->type = type; 
put_addr (ptr, type); /* Fill node & increment address */ 


eeteconse (Eptr—>name + 1); 
return (type); } 


meenco. {2RR jj, per=>1n); /* No legitimate constant found We 

} 

[KKK KK KKK KKK KK kK Tang Fe KK KK KK OK KK ke / 
Peal y PE 

eand (ptr) /* Sem Check for bool and node wee 
modal ptr; 

{(PHITYPE ltype, rtype; 


ltype = semcheck (ptr->lptr); 
rtype = semcheck (ptr->rptr); 


if (!(ltype == BOOLEAN && rtype == BOOLEAN) ) /* Both children must be boolean */ 
ee eoue nw (ERREKK, pEEs>ln); 


emcee ore code ("call land\n") ; * Generate code Ad, 
Betiurn (BOOLEAN) ; 

} 

[O&K KR ee KO kk kk kkk kk kK kk Dee w Fok Ik I IA Ik Ik Ik ke / 
Pert YPE 

mor (Dotr) /* Sema Check for bool or node x) 
mocal ptr; 

Memeo yPE ltype, rtype; 


ltype = semcheck (ptr->lptr); 
rtype semcheck (ptr->rptr); 


1f (!(ltype == BOOLEAN && rtype == BOOLEAN) ) /* Both children must be boolean */ 
BerrOme(ERRUKK, ptr—>la); 
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c_ store code ("call lor\n"); /* Generate code 


return (BOOLEAN); 
} 





[RK KEK KKK KKK KKK KKK KK EK KKK Tnegation Lecce ee eee CSS SOS oCCo. So oo 


PHITYPE 
tnegation (ptr) /* Sema check for neg operation 
nodal ptr; 


if ('(semcheck (ptr->rptr) == BOOLEAN) ) /* Rt child must be a boolean; 
/* lt enida seen 
Lerror (ERRECG pis. in), 


else c_ store code ("call negation\n"); /* Gen code for boolean negation 


return (BOOLEAN) ; 
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pm EE ee Re RE AN KARR KKK KKERRKRRERKKRAKRRKKREREK KR KKK RK 


* PUBLIC DOMAIN SOFTWARE * 
* *x 
x Name : Semcheck Module #4 k 
* File > Sem4.c ‘3 
yb dell gloerc: cee se COLE /sCapt J.E. CONNELL * 
* Started Oe 297 37 * 
‘eArchived =: 04/03/87 x 
ZeModrr1ed  : x 
KKK KKK KKK KK KKK KEK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 
Petiic stile Contains the following modules for the PHI compiler: 
* 2S 
3 jhalne Tthen Telseif * 
s We sve Tcomp s 
* * 
aerLGorithm: : * 
* This module contains the procedures necessary to implement the “s 
x “"if-then-elseif-else" series of commands. Tif coordinates the seman-* 
meete checking by Calling Tthen to check its left nodes, then calling * 
* telse to check its right nodes. Telse will be called until the right* 
* subtree runs out of "elses" and "elseifs". * 
* * 


KKK KKK EKER KKK KK KKK KKK KKK KKK KKK KEK KEK KKK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KEK 


* Modified =: * 


KKKKKKKKKKKKKKK KKK KKK KKK KEK KK KK KKK KEK KEK KEK KEK KE KKK KKK KKKKEKKKKKKK KKK KKK KK / 
[RKKKKKKKKKKKKKKKK KKK KKK KKK KK Externals KKKKKKKKKKKKKK KKK KKK KKK KKK KK KKK / 


#include <semcheck.h> 
#include <string.h> /* For "strepy" a) 


excernm FLAG err found; 
Peecet mn PHLTYPE semcheck (); 


extern char *name (); 
Seeern VOold terror (), ¢c store char (); 


[ERK KKKKKKK KK KKK KKK KKK KK KK K Globals KKKKKK KKK KK KKK KKK KKK KKK KKK KK / 


emac *if label = NULL; 


[RK KKKKKKKK KKK KEK KKK KK KK KK KK KK Tf KKK KKK KK KKK KK KK KK KK KKK KR KK KKK KKK / 
PHITYPE 


moe (Otr) 7* Semantic checker for “if” node */ 
modal ptr; J PE reLo the node “i 
{extern PHITYPE numconvert (); /* Int, Natural to real converter */ 
PHITYPE type; /* Return value type 7 

Me (if label == NULL) if label = malloc (8); 
meelabel = strcpy (if label, name ()); /* Generate label ae 
ctype = numconvert (ptr); f= Cheex & conv lt and 2t types of 
c_ store code (if label); 7* Cuepuc code if an error ate 
/* hasn't been found vs 

emseore code (":\n"); 


Beeurn (Cype) ; 
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[RRR RRR RRS SO Rieter KHKKKKKKKRKKKKKKKKEKRKKKKKKEKK KKK A 


PHITYPE 
tthen (ptr) /* Sem checker for then node =/ 
node! pia. /* Pointer to the node x/ 
(PHITYPE ltype, rtype; /* Type returned from left x / 
char *label = callee a1); /* Jump for asmlanguage code =f 


char *holder = calloe mt: , 1)-¢ 
strcepy (holder,if label); 


if((ltype=semcheck (ptr->lptr)) != BOOLEAN) /* Left node contains condition ees 
/* must be a boolean «7 





terror (ERR per-- per—2in) | 


if label = strepy (if label,holder); : 
label = strcat (label, name ()); /* Get a label for assembly code */ : 
c store code ("call igetvalue\n"™) ; /* Print proper code = 

G2 store code. ( chpean, - wih, 

c store code ("jne "); 

CUSCOLle Teodem babe Ee 

G store code (ns): 

rtype = semcheck (ptr->rptr); /* Check rigntes tae ei! 

G store code ("jmp"); /* Generate code “7 

c store code (if label); 

G store codesi "va: 

GG storercode (facet; 

c store code (":\n"); 

return (rtype); /* Right type is returned <7 


[RR IO KK OK KKK KK Telseit KOK RK KK KK KK KK / 


PHITYPE 
relsert (ptr) /* Sem check for "elseif" node iy 
fodal- ptr: /* Ptr to the node bs 
{extern PHITYPE numeonvert- “() > /* Function converts and retuunisueees 


/* left and right types i 
return (nHumcONnVert {ptr)); 


[RRR KK RK KKK KKK KK KK RK RK KK KK Telse KR RK kk RK eK & / 


PHITYPE 
telse (ptr) /* Sema checker for "else" node bee 
nodal “ptr; 


recurno(semcneck *(pLr— siptr)); /* Return left side, +7] 
/* right side is always endif 4 


[RRR KKK KKK KK KK KKK KKK KK KK KK Tcomp OK IRI FI I I FI I I / 


PHITYPE 
Secomp /( per) /* Handle comparisons and aes 
/* set membership operations =7 
/* FOR INTEGERS AND BOOLEANS ONLY */ 
nodal ptr; 
{extern PHITYPE numconvert (); 
PHITYPE type; 
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type = numconvert (ptr); 

switch (ptr->name) { 

case (EQ ) meee sore code ("call iequ\n"™); 
break; 

case (NEQ ) :;: c_store code (“call ineq\n"); 
break; 

case (KW + LESS ) 
ersvore code, iVealleri iin”); 
break; 


Casecemrne teGREATER } 
¢ stememeode ("call igt\n™); 
break; 


Gases(tEO ) +; c store code (“call ilteg\n™); 


break; 


case (GEO ) PG score code ("call “igteq\n"™); 


break; 

case (KW_ + IN ) 
G store code (“call in\n™); 
break; 

edse eA Nee eNO PIN) < 

Gpseore code (“call norm vn"); 
break; 

default mece ror ERR ly sper = on); 

break; 
} 
return (BOOLEAN); 
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/* 
/* 


/* 
fs 
/* 
/* 


EAS lor POR FULURE. USE 
REALS ARE IMPLEMENTED 
Check cases 


WORKS ONLY FOR 


BOOLEANS 


== NE oo oen OAL 


INTEGERS AND 


Check and convert if necessary *. 


«, 
“7/7 
=f 
« / 


+7 


[RRR K KKK KKK KKK KKK KK KEK KKK KK KKK KKK KKK KR KKK KK KK KKK KKKKKKK KKK KKKKKKKK KKK 


* PUBLIC DOMAIN SOFTWARE * 
*« * 
* Name  °: Semcheck Utilities.1 * 
* Fale ao CmNe.. c * 
* Authors >: Maj E.J. COLE / Capt J {EB Geile * 
A AiGwateee 7 OE 02 om * 
* Archived) 3 ~04/03737 * 
* Modiriled la: * 
KEK KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KK KK KKK KKK KKK KKK 
* This file contains the following modules for the PHI parser: ss 
*x * 
* Putvar PReronrm Makeform Findvag * 
* Getfptr Getvtype Finddef Put adda _ 
x Name Gecdcype Form Makevar * 
: Pingel t And_Alloc Add_And De PeAria * 
x * 


KEKE KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK 


* Modified =: x 


KKK KKK KKK KKK KKK KKK RK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KK KK KK / 


[RK KKK KKK KKK KKK KKK KEKK Pxternals © * RRR RRR KK IK IKK RIK / 
tinclude <semcheck.h> 

#include <string.h> /* fOr “sepcpy. =/ 
[RRR RRR KKKEKKKKKKKKKKKKKKKKKKE GlopalLs KKK KKK KKK KKK KKK KK KK KK KK KK KKK / 


FLAG err found = FALSE; /* True if an error found ae 
long curr_addr = START ADDR; /* Next address to be used to “7 

/* place a variable “7 
long curr_scope = START_ADDR; /* Current scope a 
EOom. = FALSE? /* True if formals being processed*/ 
[EE Ae yet able Definitions **XXRKKK KK KKK KKK KK KKK KK KK / 
ims CYPEDCE =I YeaeiNIT, /~ Ptr to last typetable insert pee 
tnode types [MAXTYPES]; * Typetable = 


[ERR KKKKKKKKKKKK KK KKK KKK Vartab le Definitions KAKKKKKKK KK KKK KK KK KKK KR KR KK / 


Ter 


varptr varhead = NULL; /* Head of varlist linked Tage <7 


[RK KKK KKK KKK KKK KKK KKK KK KK beftable Definic vonsc KKK KKKK KKK KK KKK KKK KKK KKK / 


defptr defhead = NULL; /* Head of deftable linked iist “7 


[RRR KKK KKK KKK KKK KKK KKK KK And best Definitions **XRRKKKKKKKK KKK KKK KKK KKK / 


and_ ptr and_head = NULL; /* Head for and list «/ 
and flag = FALSE; 


[RRR KKK KKK KK KK Makeform ROKK KIKI II I I I / 
fnoae 


*makeform () /* Create a formal node =7 


rettrn (itnode*) calloc (1, sizeoct (inode) 4): 


[KKK KK KKK KKK KR KKK KKK KK KK KKK KK Putform KK KKK RK KK RK RK KK RK / 


void 
putcformm (Eyre) /* Put type into formal list “7 
PHITYPE type; 
{extern fnode *fhead; 
fnode w*otr = makeftorm) {), /* Make a formal node “J 


“tracer- /* Tracer for the forma. ye 
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ptr->type = type; 


if (fhead != NULL) { 
tracer = fhead; 


while (tracer->link != NULL) 
teaecer = tracer=> link; 


taacer-- link = ptr; 
ptr->link = NULL; 
} 


else { 
fhead = ptr; 
ptr->link = NULL; 
) 


j= TE Vist already exists 


/* Pana) end vor. iss 


/* Insert Node 


J* Lt no ese 2 inserc 


ros 


at 


pee RR KRKKKXKKXKKAKKKKKKEKEKKKKKKKKE Makevar KKK KKK KR KKK KK KK KK KK RK OK KK RK KK KK / 


GRe ena 
maxevar () 
{ 
return (struct varnode*) 


Cavlec (1, sizeof (struct varnode)); 


7 


/* Make node for vars linked lst 


By. 


[RK KKK KKK KKK KK KKK KK KKK KK KR KK KKK Putvar KK KK KK KKK KK KK / 


void 

putvar (type, treenode) 
PHETYPE type; 
nodal treenode; 


fextern int form; 


Varptr ptr = makevar (); 
ptr->nptr = treenode; 
ptr->type = type; 
Ber-oform = form; 
Ber->link = varhead; 


varhead = ptr; 
ptr = NULL; 
Free (ptr); 


/* Put variable in vartable 


J* Fill entry 
/* Set formal flag 
P-Bset top of Linked Jist 


/* Free pointer space 


| 


a 


sat 


[ERK KKK KKK KKK KK KK KKK KK KK KK KK Findvar KK RK KR KR KKK RK KK KK / 


Varptr 
findvar (varname) 
long varname; 


{varptr ptr = varhead; 


while (ptr != NULL) { 


if (ptr->nptr->index == varname) 


Beciwi~n ap Ct) 
Bee = ptr=>link; } 


retuen (NULL)? 


J*® Fina var in Vartable 


Jeerravel list, look for varname 


je Break ee varlable round 
J/= Return ptr to proper varnode 


/* Increment link 


/* No tally on variable 


iad 


a 


ay 
ma 


ee 


ua | 


[RR RRR ER RRRKKEKRERK EEE KAAS Getvtype KAKKKKKKKKKKKKKKKKKKKKKKKK KK KK KK / 


PHLITYee 
getvtype (ptr) 
VarDer Dtr, 


return (ptr->type) ; 


/* Get type of var in var stack 


7 


[RR KRKKKRKKKEKKKKKKRKKKKKKKKEKKKKKE Putdef KHKKKKEKKKKKKKKKKKKKKKKKKKKKK KKK K/ 


void 
putdef (type, treeptr) 
PHITYPE type; 
nodal treeptr; 
{extern int form; 


defptr ptr = (struct defnode*)calloc(1, sizeof 
ptr->nptr = treeptr; 
ptr->type = type; 


ptr->link defhead; 
cGefhead = ptr; 


[RRR KKK KKK KKK KK KKK KKK KK KK KK Finddef 


defptr 
finddef (varname) 

long varname; 
{(GeEStr ptrr = defhead; 


while (pireta. NULG)O ot 


if (ptr->nptr->index == varname) 


FEGUEN (otr); 
ptr = ptr->link; } 


return (NULL); 


} 


/* Put var in definitions fea 


(struct defnode)); 


/* Fill -eneey 


/* Set top of Linked lice 


/* Free pointer space 


/* Find var in defttabic 


/* Break if variable found 
/* Return ptr to proper varnode 


/* No tally on variable 


“7 


*7 


*7, 


«7 


KKK KKK KKK KK KK KKK RK KK KK  / 


“7 


<7 
“7 


"7 


[RRR KKK KKK KKKKKK KKK KKK KK KK KKK getfptr KKK KKK KK KK KKK KKK KKK KK KK KK RK Kw / 


fnode 
"SEC totr. (our) 
detpcr -ptxr; 


VEUULS pers Epis). 


/* Return fptr from def table 


7 


[RRR KKK KKK KKK KKK KKK KKK KK KKK Getdtype OK RK RK Ke / 


PHITYPE 
getatype (ptr) 
defptr ptr; 


Feturn Pipl rst ype): 


/* Get type of var in def table 


bh 


[RRR KKK KKK KKK KK KK KKK KK KKK KKK Add anc OKI II KKK KR / 


void 
add and (pre) 
nodal ptr; 
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/* Add and_node to and list 
/* Ptr to nede containing mam 


“7 
<7 


{extern and ptr and head, and alloc (); 
externwent, DUEL ptr; 


aideperea PEE = and alloe ();; 


emper--7OuULfptr = 
a Ptr=7per — ptr, 
a ptr->link = and_head; 
endaneads= a ptr; 


Hunt ptr, 


oePe ee = NULL, 
Reece a OUl) 7 


[ERK KK KKK KKK KKK KK KKK KKK KKK KKK KK And Piloc 


and ptr 
gadralloc () 


{ 


peewee (SEELUGCE and struct*)calloc (1, 


sizeof 


Po onoldern fOr Andeoer ney 
(22SEC PEr EOVECUTrent BbuUEfer ptr */ 
/* Get ptr to node with var def = / 
7* link node to list 7 
/* Dispose of a ptr ey, 


KKK KKK KKK KK KK KK KK KKK KKK KK KK / 


j/* Create a node for and list af 


(SEructrand struce))) 7 


[RRR KKK KEKKKKEKKKEKKKKKKKKK KKK KKK Del and KKK KKEKKKKEKKEKKKKKKKK KK KKK KKK KK / 


void 
aeleand (ptr) 

arasper |pcr, 
{extern and ptr and head; 
apcepekeseabcn — and head; 


He w(ptr §'= and head) { 
while (search->link != ptr) 
search = search->link; 


Searen->link = 
} 


PEr=2link; 


else and head = ptr->link; 


ptr->link = 
free (ptr); 


[KKK KKK KKK KKK KKK KK KKK KKK KK KKEK Torror 
void 


eerror (err num, line num) 


mac err num, 
{extern 


line num; 
mp sornandler =): 


err found = 


TRUE; 


ErrorHandler (line num, err_num, SEM ERR); 


[RRR KKK KKK KK KKK KK KK KK KKK KKK KKK Pubacar 
void 
put_addr 


(ptr, type) 


moagal ptr; 


oe 


/* Delete entry into the and list */ 
/* Case 16 sointer not equal to a 
7* Girst enery in Liste ae, 
7~ Place ptr on entry above ay, 
fee Gt uent Ty =) 
/* Set pointer aif 
(2 SCaseceper’ = 0671s entry in lst. */ 
/* Dispose of uneeded node Of 


KKK KKK KK KK KKK KKK KK RK KR KK KK / 


/* Sem check errcer handling a 
/~ TOueE Tne oe 
/* Set err found to true & a 4 
/* stop code gen rs 
/* Generic error handling proc le 


KKK KKK KK KKK KKK KK KKK KK RK KKK KK Ke / 


/* Inserts virtual address of od 
/* variable/function return av 
/* And increments curr_addr a 
/* Assumes global curr_addr ea 
/* Pointer to target node a 


PHITYPE type; /* Node type “/ 9 


ptr=>addr = curr addr; /* Set node address 7 
PEE->SCOpe = etree seo pe, 
curr addr = curr addr + (types (type) >/ceam /* Increment curr addr by numeGeam 





/* bytes type needs a 
if (curr_addr > MAXADDR) /* Error if address exceeds “ih 
/* address space «/ 


terror (ERRemmymocr=22n 7 


[RRR KKK KKK KEK KEK KKK KKK KK KK KK KKK KK Name KKEKKKEKKKKKKKKKKKKKKEKKKKKKKKER RT 


char 
*name () /* Generate an appropriate name “7 
/* for a label/ proceaure “7 
char “string = smatiloe-(1)¢ /* Holder for outoue “7 

“string. = malioe, (1)¢ 

static long seed = 10000; /* Number to append to string “7 
Slr Eeng. =) Vas /* SUring oresu x7 
*(string + 1) = ENDSTRING; /* Insert string terminator “7 
stcl.d (String! seed), /* Convert long seed to string <7 
String = -Strcat (serine, sercang.). /* Concatenate strings “7 
++seed; /* Iner int to avoid duplicates 


Feturn (String 


[RK KKKKKKKKKKKKKKAKKKKKK KKK KK KKK Formal KKK KKK KKK KR KR KKK KK KKK RK KK KKK Kw / 
FLAG 
formal (oer) /* Returns true if the varnode =] 


/* describes a formal <7 
VaEDLE SUE; 


If (peEr=SioOrm) return (1IRUE) ; 
else return (FALSE); 
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APPENDIX K 
ROCK COMPILER — CODE GENERATION MODULE 


Pen XK KKK KARA KK KKK XK KKKKKKKKKKKAKAKAKKAKAKRKKKKKKKKKKKKKEKKKAKKKKKKKKK KKK 


* PUBLIC DOMAIN SOFTWARE x 
* * 
* Name : Code Generation Module * 
* File WE coce Gen ic x 
x Authors wea ge On COLE 7 seaote J.B. CONNELL * 
* Started me 02/06/87 * 
* Archived : 04/10/87 x 
* Modified : 04/13/87 Code output to vdisk EC * 
KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KK 
* This file contains the following modules for the PHI compiler * 
* * 
x C Store Code Giscartup GzOlr cInserte ‘ 
. Ga2nding C Printcode GOAcOr * 
. Acode C_Jmp Geo caLemeros x 
. GElmeconset Cal form ClEnd ae coe - 
i Clr Op Sealer EOC 
* * 
feeeigorithm : ss 
* This module contains the procedures necessary for code generation. * 
* C startup initializes the run_time file, & the semantic checker will* 
meallimt ne Procedures as necessary. Note that "ec store code” 1s a ‘ 
* genaric generator which will spew any string given as an arg to the * 
Swoutput file. * 
* * 


KKK KK KKK KKK KKK KKK KK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KEK KKK KKK KK KKK KKK KKK KK 


Mertodatied =: 04/13/87 Code output to vdisk, drive "d:" Ee : 


KKK KKK KKK KKK KKK KK KKK KKK KKK KK KK KKK KK KKK KKK KK RK Ok ke  / 


[RKKKKK KK KK KKK KK KKK KKK KK KK Bveernals KAKKKKKKK KKK KKK KK KKK KKK KK RK KK KK / 


#include <semcheck.h> 
#include <string.h> 


minclude <fcntl.h> /* For level 1 I/0 a 4 
Seeerm FLAG @rr found; IEEE Or flac a 
Pxcern long curr addr; PsICUREeCNE Virtual. acdaress a 


[RRR KKK KKK KK KKK KKK KKK KKK KKK KKK Globals KKK KKK KKK KKK KK KKK KKK KKK KK KK KK / 
char *code buffer; /* Buffer for output code ee 
mee DULS ptr = NULL; (een O eNars. ta GuEoue our cen. ¢*/ 


[ERK KKK KK KK KKK KKK KKK KKK KK KK KKK es Store Code KKK RR KK KK RK KKK KK KK / 


void 
¢ store code (string) /-SPULeser into the cuepuc butter */ 
Eagar “string; /* String to be printed = 
fees ecr = NULL;  vemeeo tne chars Mi tnpuc- str */ 
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if (!err found) { /* Compute only if no error cGumeumee 


while. (*(string 485c7). —))0Lo ee /* Copy string char py vedas <7 
*(code buffer + butt ptr) = “(strings some 
++ptr; 


[RRR RRR REKERNKEKAKAKRARR RAK ER S Jmp KK KKKKKKKKEKKKK KE KKK KX & KK KARE 


void 
c jmp (name) /* Gen code to insert jum> Commarea 
cnar *name; 


ENSEOre)| Code (" jmo~ )- 
G Store code (aame), 
G store code (*"\a. 7 


} 
[RRR KKK KKK KKK KKK KKK KKK KKK KKK c Stare Proc KERR KKK KKK KEK KKK KKK KK KK KK KK / 
void 
c start proc (name) /* Output name for start Ofmaem “zi 
/* language procedure <7 





cnar *name; 


c store code (name); 
c store code (":\n"); 


[RRR KK KKK RK RRERKKEKEEEEKER C End Proc #84 KKKKKKKKEKHK XK KK KR Ree 
void - 7 
c_end_proc (name) /* Output name for ending an “7 
/* assembly language procedur at 
cnar *name; 


6 SLOre needa | cali delsseope ni, 


GC sStore eade Areva"); 
Sestcrercode | namnei:; 
estore “code (i: \n-"); 


[RR KKK KEK KKK KKKKEKKEEKKEEEK C Call Prog «KKK RKKKKKKKEKKKKKKK & Kee ee 
void 
c call proc (name) /* Output call for an assembly <7 
/* language procedure <8 
Cnar *name; 


G store code (%eall .%) ; 
€ store code (name); 
G Stone Oder in); 


[KKK KKK KKK KKK KKK KKK KKK KKK KK cS ag EO Ei KK KKK KKK KKK KK KR RK KK RK KK Ke / 
void 
CoLMe orn a num) /* Generate call to put integer at 
/* formal addr Onwvo seaen = 
ehar. *num; 


€ store code (‘mov ex," ); 

6 store scode (num); 

CG IStonescode wt au 

Gc store code ("call 1 formal \n"); 
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[KKK KKK KKK AREER CT CONSt 2 RRR RRR RR RK RRR RK RK KKK / 


void 
Gerecons. (name) 


char *name; 


epocore code ("mov ax, ’); 


Gaoe ore code (name); 
eyeeore seode. {i'\n"); 


@ store code ("call iputvalue\n"); 


) 


y~ Outout Code Gor assiaqning an 


/* integer constant 


oe 


tes 


J RERRKKEKRKEKKKKKKKKKKKKKKKKKKKE (& ic Op KKKKKKKKK KKK KKK KKK KK KKK KKK KK KKK KK / 


void 
eee op (op) 

optype op; 
{extern void terror 


Switen (op) { 
case (ADD) : 
break; 
ease (SUB) : 
break; 


case (DIVIDE) 


break; 
case (MULT) 
break; 
default 
} 
} 


return; 


Chica Ll proc fada) ; 
Gicall proc (sub); 
Cpealprec sy (edi 


e call oroc) (imine) 


,-sOubous code fOr int arith ops 


f/* Tyee Of operation 


[RKKKKKKKKKKKKKKKKK KKK KK Staten. 70 n ~ awa RAK KKK AAKKAAKRAKKAKRKK AEE / 


void 
Sescartup () 


Mepeoore DuLrer — gecmem 
"extrn 
"extrn 
rExtern 
Texte en 
hextrn 
"extrn 
"“extrn 
"extrn 
"extrn 
“ext rn 
"extrn 
"extrn 
"extrn 
VexXGrn 
"extrn 
"extrn 
"extrn 
"extrn 
"extrn 
"extrn 
"extrn 
"“extrn 
“extrn 
"extrn 
"extrn 


GC store code 
euseore code 
Se core code 
eocore code 
ecole Code 
Soc ore code 
emoeore code 
eeocore code 
ers Ore code 
Peo -ore coce 
eas Lere code 
emoecore code 
Emo ore code 
Gescore code 
pms Ore code 
emo eore code 
Seocore code 
Sms core code 
eeoeore code 
Gascore code 
eeoeore code 
Seestore code 
emseOre code 
ese oLe code 
eeocore code 
pec ore code 
Eeoeore code 
Peo core code 


om 


(STZEBUPFER) +; 


Pedals ene ar \ih.. by 
iadd ; near\n"); 
isub ‘eonlear Va") 
Lm lt : near \n"’); 
idivn : near\n"); 
lequ : near\n"); 
ineq : near\n"); 
eis ot  healk je; 
Tbe near \n )- 


land = near\n"'}; 
hewn feanear \n 
igteq : near\n"); 


iputcvalue = near\n")+4 


ilteq : near\n"); 


igetvalue : near\n"); 


imiea Let anear \ Vn’)? 
finis = near\n"): 


Prince toe i near \n') > 


negation : near\n"); 
HE OrMd le eenear  n ) 
bomov = near \n"); 
ppush : near\n"); 
peop 3 near\n") ; 


add scope : near\n"); 
Geleseope = near\n”), 
VoLrg -OlOOn \a ya"); 
Neseq\n'); 

edie val yn") s 


oe 


/* Open and initialize files 
J* THnitialize bueter 
/* Write utilities needed 


ae 
yf 


«/f 
ad 


x / 
t 


[KKK KK I IK IIR KK C Print Code «te KIKI KK II / 


voOLa 


¢ print_code {) 


{extern char prefix 11, 
int code; 


char holder{30]; 


SErepy 
SErCat 
strcpy 
Strcat 


code = 


write 
close 


(nolder, 
(holder, 
(BEE ELK, 
(holder, 


(code, 


(code); 


ea oh a) 

prefix); 
holder); 
oP We ot ta 2 


open(FILENAME,O TRUNC 


Gece wourter, 


O WRONLY, NULL); 


DULL SpEry: 


/* Output eode bur ce ceac x/ 
/* secondary storage a/, 


/* OUtpUuE Seae “7 


/* set up file name =f 


/* save prefix & drive for fut use*/ 


/* Open file for writing and 7 
/* overwriting ony ay 
/* Write the buffer hi 
/* Close the output file a: 


[RK KR KK KR RK RR RK RK Ending *******KEAKRKARK KK KK XX XX XA 


void 
c_ending 


{ 


() 


LE Wlerr 2ound) mt 


€ store ode 
c store code 
* (COGe DURTer =: 


G print code 


[KKK KKK KKK KK KKK KK KK KK KKK Clztor 


void 


GZeor 4G) 


{ } 


[ERK KKK KK KK KKK KKK KKK KKK KKK KKK Acode 


vold 


acode (otr, 


nodal 
FLAG 


otr; 
type; 


tyre) 


(‘cali Prine Tooin:)4 
/* Print address pointed to by 


Cleat fins n)) 3 
(HUEE CE 4+) ) 


Oe 


(extern. Vole terror ((7 + 
int name; 


ghee lag =i a 


switch (name) 


case 


Case 


case 


case 


(ADD_) 
else c_i_op (ADD); 
break; 

(SUB_) if (type 
else ¢ 1 op (SU 
break; 

(MULT) if (type 
else c_i_op (MULT); 
break; 

(RDIV_) 


ptr->name; 


{ 


if (type == REAL); 


break; 


== REAL); 


/* Ending £o0r outputr cede <7 
/* top of program Stace a 
/* Routine to make clean ending 7 
/* If no error, put asm language */ 
/* delimiter to file gl / 
/* Output code to a fie i 


ROR KR RK KK RK RK RK KR KR RK KK OK / 


/* Gen code for conv int 2t0 Zea 
/* Empty now, but watch our smoke 


KOK KK KK KK KK RK KI / 


/* NOTE ;: USES EMPTY STATEMERG 7 


/* FOR REAL OPERATIONS mh 
/* Generate code for arith ops ais 
{* Addieren ays 
/* SUBEraceE1 On ae § 
/* Multiplication ih 
/* Real Division ai 








/* Integer Division 


a 


APPENDIX L 
ROCK COMPILER — USER INTERFACE 


[RR KKKKEKK KKK KEKE KEK KKK KEKE KKEKKKKKKKKKKEKKKKKKKKKKKKKKKKK KKK KA KKK Re 


Name >: User Interface 

File > | User Gc 

Authors : Maj E.J. COLE / Capt J.E. (cennemn 
Started >; 04/0178 7 

Archived : 04/10/87 


Modiiled: 


KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK 


This file contains the following modules for the PHI compiler 


User een. Getname Prog name 
Primteiedgacr Prelase Use 


Algeria tame: 
This module contains the procedures necessary for the user in- 
terface. 

Prog Name gets the user's choice of program by calling Geum 
Print header is called to print the initial screen display on con- 
sole, & the User procedure is the overall coordinator of the inter- 
face. 

User Err and P_Close are both independent procedures. User Err 
handles output in the event that an error or errors have been found. 
P close is called by "Rock_Main”" to ensure the input file Nas bee 
closed. 


+ + + ££ ££ A HF + + FF F FF FF F 4H OF F F FF F HF A OF 
+ + + 4+ £ + 4 4 & 04 4 4 HA 4H HH KH HH KH HH HF FEF HF H 


* 


RRR KEK KKK KKK KKK KKK KKK KKK KKK KKK KEKE KKK KKK KE KKK KKK KKK KKK KKK KKK KKK KKK KKK KK 


* Modified =: * 


FI IK II KIKI I IK RK IK IKK II I I I I II KOKI IK KO eK ee / 


[RRR RK KK KKK KKK KK KKK KKK KK KKK KK KK Bxternals kK KK KK KK RK KK KK OK oe / 
#include <user.h> 

Binclude <cos.1> /* £05 “qecenn):. “7 
extern void clrscer (),,. movecursor ()7-cle window aus 


[RRR KKK KKEKKKKKKK KKK KKK KK KK KR KK KK Globals ROR KKK IK III III I IK I II / 


char u_name [BUFFLENGTH], /* Name of Source file =i 

prefix [BUFFLENGTH]; /* Prefix of source file “J 
Gem Toe 7 Fs liae * . +49 Se « 
Pees ino ve. /* File handle of source file ve 


[RR KKK KKK KKK EK KEK KKK KKK KK KK KK KK User ier KOK KOK IK ROKK IK KK  / 
void 

user_err () /* Screen interface for error msg */ 

(extern voldiemesce .())7/ 
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extern int Aum errors, 

Foe errors; 

eat onumolLocks, 
eount = 0; 

char *buffer = malloc (BSIZE), 
inouc; 


errors = fopen (ERRORFILE, “a"); 
Porcine. (errors, 
"number of errors = %d\n",num_errors),; 
bume et 9’; Errers); 
fclose (errors); 


eimser {); 
errors = fopen (ERRORFILE, “r"); 


Mumobocks = fread (buffer, BLOCKSIZE,20,errors) ; 
mule os bouLrfer + count) !'= '"S") ¢{ 
PUcoNaret=(buUbEer + Count) ); 
Count; } 
Pelwees. \n \n \n"); 


print. ("*%s",. PAUSE); 
aoe = getch {); 


fclose (errors); 
eibesecr () 


if (input == ESCAPE) exit (1); 


[RRR KR KK KKK KKK KK KKK KKK KKK KKK KK KK Getname 


void 
getname () 
mont ch, 
count = 0; 
co { 
1f ((ch = getch ()) == BACKSPACE) ({ 
He (count) | ——count; 
Pueciar +(e); 
BUECMar (° 9"); 
pubenan (eh); 
} } 
else if (ch == ESCAPE) { 


clrscr () } 
Exit (ly } 
else if (ch < 127) 


{ 
pucenaz, (ch); 
u_name [count] = ch; 
Secount; } 


} while ((count <= BUFFLENGTH) 6&& 
ei | OLN): 
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s fs 
/* 
[x 
Ye: 


/* 


/* 


/* 
/* 
i= 


/* 
{[* 
/* 
/* 
/* 


/* 
/* 


Number Of errors tound 
BErOr © tle 

Number of blocks to read 
Generic loop variable 


Keypressed after pause 


Put EOF marker to file 


ae 


Read error mgs from error files*/ 
BLOCKSIZE Will allow wnole 


E1lente be reag al once 


Skip lines to give appearance 


of user friendliness 


Pause to give user a chance to 


comtemplate his errors 


Eat keyboard input after pause 


If user pressed escape, 
exit the program 


= 
iy 


ale | 
aa 
we: 
a 
my 


Be 
ae 


KKK KKK KK KKK KR KR RK RK KK KK / 


tins 
/* 
/* 
/* 


/* 
/* 


/* 


/* 
/* 


Hires 


/* 
/* 


Returns the user's choice 
of file to compile 

Single input character 
Buffer pointer 


Loop, get file mame ltr by ltr 


o- KEY, 1S snk 


Backspace 
Insert blank 
Eat last char if there is 


Escape pressed; exit 


Legitimate char read; use 


Heoopeunti) buffer full or 
return pressed 


One 


ane 


es 
we 
oy 
ei 


ag 
ag 


es 
mes 
a 


= 


af 


nied 
zy 


uname [Count saan — 0; /* Insert end of Stringee 1a. «/ 


[ RR KKERARA KR K RRR AK XE AKA A RAXK AX Prog name KKKKKKKKERKARKKERKK KX & x Ke 


void 
Prog Nament /* Get legitimate program name x / 
ao { /* Loop until fopen finds 7 
/* legit name x / 
clr window (971) 21772), /« Clear out lower window Of /S@amueas 
MOV Cursor wt 10r2) 
printf (GETPROGRAM) ; 
getname (); 
infile = fopen <ulmame, 42"); 
if (!infileje /* Name not in current directory */ 
mov cursor {2Z00s3)7 /* Print user friendly error umsaqauam 
printf (FILE1 ERROR); 
MOV CURSO “(C2 iealon, 
printt’ {PILE2 ERROR), 
if (getch () == ESCAPE) /* Exit if ESCAPE pressed «/ 
clrscr < 
exit (1); 
} 
} 
} while (!infile); /* Repeat until correct file found*/ 


/* NOTE - escape exits loop €¥gnaqmar 
mOV "“CUrSOr (13, 25)- 
DLINT © StWALT) 
} 
[KKK RRR KKK KKK KKK KK KKK KKK KKK KK Print header KKK KK KK KKK KK KKK KKK KK KK KK KK / 
vold 7 
print _header () /* Print out header for uses i: 


pe 


Clr sce (Oe 

MOV _CUrSOr (17733); 

Prinet (HEADER). 

MOV Cursor (2,24); 
rinct CHEADERZ) > 


| 
> 
4 


[RK KKK KKK KK KK KKK KKK KKK KKK KK KK P Close KKK KKK KKK KKK KK KK KKK KKK KKK KK KK KK / 
youd 

p close () /* Close out target file i! 
Felose (inti ee: 


[RK IKK KKK KK RK KKK KKK KK KK KKK KKK User FO IK II IK I III II I I I / 


void 
user () /* Invoke user interface = 
(ine 22ount. =20r /* Duty integer be! 
Drinc Neadera(); 
prog name (); 
white (! (uw Sname@ (count) —-—s".* /* Copy root of input fies a / 
|| u_name [count] == NULL)) { /~ Loop until end of input name a 
/* reached OR until end of stz is */ 
prefix [count] = u_name [count]; /* reached, if no extension = 
++count; ) 
oretix <[ecunc1 a= s0, /« Insert end of string value 77) 
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APPENDIX M 
ROCK COMPILER — RUNTIME UTILITIES 


CK KKK KK KKK KKK KKK KKK KK KKK KEK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK 
, 


;* Name >: Phi Runtime Utilities * 
pe File 4) .ago * 
me AUCHOrs fea ee COLE 7 Cage WJi.E. CONNELL * 
;* Started wo ly 207 G7 x 
meeecchived <= i6 Feb 87 * 
;* Modified : 16 Apr 87 Stack/Varspace Crash error check EC * 
KKK KKK KKK KKK KKK KKK KKK KR KKK KR KKK KR KR KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 


pRKKKKEKEKKKKKKKKKKEKKKKKKKKKKKKKKKEKKKKEKEKKKKKKKKKKKKKKKKKKKKKKKKKK KKK KKK KKK 


; ALGORITHMS 


9 aa Preue,Curpue: Tne first section of the program contains input and output 

‘ 

tee. Virtual Space: A virtual space is set up in the extra segment to hold both the 

i stack. The middlej of this space is denoted by the symbol "vars", and variables 

; offset (£ 32700) from vars. In this implementation, the program stack grows from 

: vars grow from the bottom. The virtual space is assumed to be made up of words 

(two bytes), so only 

: even numbers may be used to access it. 

mS. Sege woe nee Stack POInTeGr 1s the si register, which is initialized to 3270¢C. 

: grows, the si register is reduced by two. Ppusn and ppop will push and pop two 

registers. "Push one" and "Pop one" will push and pop single words to and from 

4, Addressing Program Variables: Each program variable is assigned a two-tuple A 


scope and O is the offset from the base address of variables in that scone. 
turn the address of a variable given A. 


ay Beoping: s initially the scope is set to 0: the global scope. The variable 
space containing the outer scope, and the variable "S Nest" contains the current 
: new scope is created, "S Nest" is increased by one, and the three-tuple S = 


™e ~e *e oe “se Ye We Re 


; (L = Static Link, pointing nesting level of the outer scope, N is the nesting 
: ls the base address of display of variables for this scope. 
: When a scope is deleted, the top of the stack is saved, the top instantiation of § 


: and S Link and S Nest are recalculated. 


f 

pepo enSerting/Extracting Program Variables; "I Assign” will insert an integer or 

; scope contained in S Nest when it is requested. "Iputvalue" will insert the 

: resoponding tuple A on the stack. "“Igetvalue" will pop the tuple A off the tcp of 


; the value of the integer pointed to by A. 


“se 


PR AR RK KKKKKKKKKKKKKKKEKKKKEKKKKKKKKKKKKKEKKEKKKKKEKKEKKKEKAKKEKKEKKKEKKEKEKEKKKKKKKKKE 


se RKKKKEKKKKKKKKKKKKKKKKKKKKKKKKKEKKEKEKKKKKKKKKKEKKKKEKKKKEKKKKEKKKKKKKKKEKKK KE 


;* Modified : 22 Feb 87 Add/del scope changed to save TOS. EC x 
jas 16 Apr 87 Added check for stack/varspace crash, includes* 
al message to observer x 


eeK KKK KKK KKK KKK KK KKK KKK KKK KK KKK KK KKK KKK KKK KEK KEK KKAKKKKKKK KKK KKK KKK KKK KK K 
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, 
sR KKK KKKKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKKKKKEKKKKKKKK KKK KKK KK KKK KK KK KK KK 


Bs Public Procedtres x 
KK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 
gf 


public sl mov 

DUD EGele Olinda 
public lgetvalue 
DUD Pic 26 ins 
public iputvalue 
public Lind waddr 
lie tadd scove 
lic Geleseope 
Lic rinie Lal 
Lie. finis 

TC Spush 
PuUbLIC ppop 
oublic iassign 
eh bled lowe uel g 
SiO e Land 
public iequ 
public ineq 

DUD Lic 


Bub iL re seceg 
public negation 
DUD Le Vlada 
publ EC 1Sub 
public imule 
Buble, Lain 
PUDLLC Print lop 


sR KKK KKK KEK KKK KKK KKK KKK KK KK KKK KKK KKK KKK KKK KKK KKK KK KKK KK KKK KK KKK KKK K 


x *« 
ria I/O Procedures * 
x * 


pew KKK KKK KK KKK RK KR KKK RR kk KR kK kk kok ok kkk kkk kok kok ok ok kok ok kok Ok kK ok kok ko kok kk & 
se RRARKRKARAKAKRKAKARKAAKARXX print char KkeKkKe Keke KKK KK KK KKK KKK KK KKK KKK KK 
;Print a char to the screen 

;assumes letter to be printed is in dl register 


f 


Prlae. char: 


push ax ;Ssave registers 
mov ah,06 epUut aint vector 
poh aera eg 

pop ax 

ret 


PRR KKK KKKKKKEKKKKKKKKK KKK K Eoin Kee KKK KKK KKK KKK KKK KKK KKK KKK KKK 


‘Prints enad=of line Character to tneescer rece 


eoln; mov dl, 10 ;Moves appro ascii values to crt 
call pulnewenar i IBM Speci tue 
mov idles 
Gall pn ine, chiar 
ret 


p RRR KKK KKEKEKKKKKKKKKKEK Pring Num KKK KK KKK KK KKK KKK KKK KKK KK KKK KK 


Prints, aS a number, the value found in the Sx vregiscees 
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print_num: 


push ax 


push bx 
push cx 
push dx 
mov cx, 10000 ;Base for dividing 
Emp. wxX,0 ;Check if negative 
jge small st. Gee. lume CO Stars 
momax =. ;Emit negative sign 
Gail print char 
neg bx ;Negate 
small: emp bx, 10 ytest if less than 10 
dnote Feld: 
div_loop: mov ax, bx 7 Divide: Dx iby "ex 
xor dx, dx ;Set up dx register 
div <x 
cmp ax, 0 
jne p_loop mie not Zero, junc 
MOV ax, CX ;Otherwise, decr cx by factor of 
mov ecx,- 10 
Mor aX, ax 
ola aoe 6 
mey cx, ax 7Mov. ax EO CX and eontinue 
jmp div_loop 
Dp loop: mov ax, x ‘Main Printing Joop 
MOm sk, 7 cx ;Set up dx register 
dive cx ;Divide 
mov bx, ax »Move remainder to 5x 
add ax, 48 PAA LOT 2aSC11 
mov dx, ax -Print 
Gab print char 
KOmeax . 70x “Seeeup dx for division 
mOV aX, CX ;Divide base value by 10 
mov cx, 10 
daw ex 
MOVeEex,) ax 
Enp ax; 1 ;If base value 1, end loop 
jne p_loop ;Else continue 
Final: 
add bx, 48 7PeEume final value 
mov ax, Dx 


Caliwpr int ichar 
call eoln 


pop 
pop 
pop 
pop 
ret 


dx 
cx 
bx 
ax 


rene Or Line 


RRR KKKKKKKKKKKKKKKKKK Print LCD Kea KK KKK KKK KKK KK KKK KKK KKK 


meeints the space pointed to by the top tuple of the program stack 


* 
tf 


eeint top: mow di, Ss 1 
acd cig 
mov dx, vars({[di] ;Get nesting level 
aad dies 
mov cx, vars(di} ;Mov offset to cx 
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10 


call findtaddr ;Mov address into sijreq 
MOV Gi,) "ex 


MOV OX, Vars cd) ;Mov num from address toeox 
call Srintenum ;Print number 

Gal weo Fy ;Inset eoln 

ret 


KKK KKK KKK KKK KKK KK KKK KKK DEine Ss KEKE KEKE KKK KKK KKK KKK KKK KKK KKK 
, — 


;assumes address of is in the dx register 
;assumes string ends with a "S$" sign 


push ax ;save register 


oop ax 
ret 


pK KE KKK KKK KKK KKK KK KEK KKK KKK KEK KKK KKK KK KKK KK KKK KKK KKEKKKKKKKKKKKKKEK 


ox *« 
es Stack Procedures * 
7x *« 


pK KKK KK KKK KKK KKK KKK KEKE KE KKK KKK KEKE KKK KKKKEEKEKKKKKEKEKKKKEKKKKKKKKKKKKKKE 


eR KKKKEKKKEKKKKKEKRKKREKEKKKRKEK Eousm KK KEK KKK KKK KKK KEK KKK KKK KK KKK KKK KKK KKK 


;Pushes values from cx (offset) and di (nesting level) 


Soush: mov vars [Si], ex Put offset in stack 
SuD si, 22 ;Ine stack pointe: 
mov vars’ [si], “dx ;Put Nest level into stack 
sub si, 2 ;Inc stack pointer 
Emp Si, curr adec *;Check for stack/varspace crash 
Jg 9 return slf£ no Crash; co iomere 
Mov Gx, OLtset crasn ;Get string for error message 
Cali «princes Pa eplicviey slic 
Callcfinus ;Halt execution 
p return: ret 


yp RR KK KKK KKKKKEKKKKKKKKKKKK Push one KEKE KKK KEK KKK KKK KKK KK KKK KKK KKK 


;Push a single integer from cx register to the program stack 


push one: mov Vars [si] [<ex sPut ‘wore sin -seac< 
Sub si, 2 ;Inc stack pointer 
ret 


KKK KKKKEKKKEKKKEKKKKKKKKKKKKK PROP KKK KEK KKK KKK KKK KKK KKK KKK KKK KKK KKK 


poop: add si,2 ;Set up ptr 
MOV Gi, Vvars. St | ;Get nesting level 
aga si 2 ;Recalc pointer 
MOV uex, vars, (si) ;Get offset 
ret 


2k RR RN RR RR Re Pop One Rae KKK KKK KKK KKK KKK KK KKK KKK KKK 


;Pop a single integer from the stack to the cx register 
pop one: AG. Si ee :;Set up pointe: 
mov cx, vars [si] ;Get word 
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;Pop values from the program stack to di (nesting level) and cx (offset) 


rec 


KKK KK KK KKK KKK KKK KKK KKK KKK KR KKK KK KKK KKK KKK RK KK KKK KKK KKK KKK KKK KK 
, 


ee Varspace Management Procedures * 
KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 
, 


° KKK KKK KEK KKK KKAK KKK , KKK KKK KKK KKK KKK KKK KKH HK HK KKK KK KKK 
pan eX PASSUon 


;Assign an integer value to a variable space in current scope 
;Assumes value is in ax; offset is set to current max offset 


e 
Ld 


iassign: Reveals ss Link 
eget static link 

Sub cde ;decrement it to pt to base address 
mov di, vars{[di] ;mov base address to di 
add di, max Orfset ;add offset 
mov vars{di], ax s;mov number into that address space 
acd mex, Orrset, 2 sinc max Offset and current address 
aga curr (adage, 2 
ret 


S RAKKKKKKKKKKKKKKEKKEKEKKEKEE Igetvalue KR KKK KKK KKK KK KKK KKK KKK KKK KKK 
;Pop the stack and move the integer value pointed to into the ax 
register 


« 
‘ 


igetvalue: call- poop; ;Get nesting level and offset 
MOV max.) oC: 
Ga meee ind addr ;Get addr of (S_ Nest, Max Offset) 
mov di, cx 
mov ax, vars [di] ;Get integer value 
ret 


arn RAK KAKKAKRKKKKAKKK KK X Iputvalue KKK KKK KKK KKK KKK KKK KKK KKK KKK 


;Takes an integer from AX register, puts its value into varspace, 
;then puts its address on the top of the stack 


, 


iputvalue: mov dx, s nest ;Get static nesting level 
MOV sex, Maxcor rset 
eq let indvaddr ‘Get addr of (S Nest, Max Offset} 
Mov dil cx 
mevEvacs (al), ax ;Put value into memory 


mov di, s_nest 
mou Gx, max Offset 


call ppush poeore, (Seles c , Max lttset) 
aagumax OLCSEL,. 2 PING Max OLTSet anc curr addr 
addeciurresacdr,, 2 

ree 


« 
, 


PRR KK KK KKK KKK KKK KKK KKK KKK KEK KKK KEK KKK KKK KKK KKK KKK KKK KEK KKK KK KKK KK KKK 


x * 
a Scoping Procedures = 
7-* *« 


PRK KKK KKK KKK KKK KKK KKK KEK KKK KKK KKK KKK KKK KK KKK KKK KKKKEK KKK KKK KKK KK KK KK 


SRK KKK KKKKKKKKKKK KK KKK Find Adds KKK KKK KE KKK KKK KKK KKK HK KKK KKK KK KKK KKK 


;Returns address of variable at nesting level dx, offset cx to cx reg 


. 
td 


eeqcd addr: mov di, s link ;Get addr of current static pointer 
find_loop: cmp es:vars[di],dx "he stack Value = scepe, exit loco 
je £ out 
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add cdar 
mov di, es:vars([di] ;Else jump to next scope and foce 
jmp find loop 


£ Out: subs diy 2 ;Calc ptr to base addr of scope vars 
add cx, es:vars{di] ;Add offset 
cee 


. * KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK 
ke eK KA Ke KRKKKKKKK Add Scope KKKK 


;Start new scope by adding static link, starting address, & nesting 
level 


. 
s 


add scope: mov cx, slink 7Get static elma: 
inc s_ nest 
mov di, s_ nest ;Get new nesting level 
call pousn ;Save link and level 


MOV CX, CUnreaddr 

mov di, max offset 

Call topush ;Save curr addr 

Mov fax offset, 0 ;Re initialize max offset 
mov s_ link, si 

add se link7s6 

ret 


RRR KEKKKKKKKKKKKKKKKE Del Scope KK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 


;Deletes a scope 


del scope: “call oper, ;Save EeOp Of seack 
mov dx, di 
call findkadar 


Push .ex ;Save absolute address of tos 
dec s nest ;Reduce nesting level 
mov si, s_link ;Decrease Stkptr to Currenuyeee, 


SUD 452464 

mov cx, eS:vars [si] 
MOV Max OLESet, ex 

mov Ox a2 

mov cx, es:vars [sit+bx] 
MOV CUrL addr, cx 


add. S15 25 

Mov cx, eS:vars [s1] 

mov slink, .¢x ;Get Current Sstalrve pam 

Pop dl 

mov ax, es:vars [di] sRestore top of ceqe_ 
call iputvalue 

ret 


KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK KK KK 


o* * 
ee Begin/End Procedures * 
° * * 


SRK KKK KK KKK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KEKE KKK KEKEKKKKKKKEKKEKKKK K 


eK KR KKK KKK KKK KK KEK KKK KKK KKK Ieee cet | KKK KKK KKK KKK KK KKK KKK KKK KK KK KKK 
, 


;initialize the stack and variables 
;must initialize cx to base of stack heap before calling this 


inLetal: MOV Sip SPACE TOF ;Initialize base of seaex 
mov di,o 
MOV iC keno 
Call “poeusi ;Push base scope ana dddrecs 
ret 
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wa keke eae eK KAKA K KK KEK KKK fans KEKE KKK KKK KEKE KEKE KKK KKK KKK KKK KKK KKK 
’ 


, 
fal dS : 
mov ax,04cO00h ;end procedure 
ae 2h 
ret 
KKK KK KK KKK KKK KKK KKK KKK KEK KKK KKK KKK KEKE KKK KKK KKK KEK KKK KKK KKK 
, 


;* Booleans * 
KKK KKK KKK KK KKK KKK KKK KKK KKK KEK KKK KEKE KKK KKK KKK KKK KKK KKK KK KK 
ya 


i? 


Peer KK RK KA KKK KKK KK KK Negation KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK 


;Negates a boolean value 


; 
negation: call igetvalue ;Get boolean 
CIA: cele ie. 
jne zero 
mov ax,0O 


jmp p ;Jump to end 

Zero: mov ax, li 

p: call iputvalue PpocUEt boolean S out adedr on stack 
ret 


pRKRKKKEKKKEKKKKKKKKKKK KKK KKK lone KEK KEK RK KKK KKK KEK KKK KKK AK K KKK KKK KKK 


;Takes logical or of two booleans and stacks address of answer 


Ors call igetvalue ;get lst boolean off stack to the cx 
reg 
mov bx, ax ;save boolean 
call igetvalue get 2nd value using the stack ptr 
Or vax, bx ;Perform or 
call iputvalue ;Put value into varspace & in stack 
rec 


. 
f 


cK KKKKKKKKKKEKKKKKKKKKKKEK lwanie KR KKK KEK KKK KKK KEK KR KKK KEKE KEK KKK KKK 


;Takes logical and of two booleans and stacks address of answer 


° 
‘ 


mang: call igetvalue pOeb 256) boolean eri stack -£oO cx tes 
mov bx, ax ;save value 
call igetvalue PecumsecOnea Value Using stack oc + 
and ax, bx Sher). ane 
call iputvalue ;Push boolean address onto stacx 
ret 


’ 
PRR KEK KK KKK KKK KKK KKK KKK KKK ITequ KEK KKK KKK KKK KKK KEKE KKK KKK KKK KKK KKK KK 


;Takes logical equal of two integers and stacks address of answer 


* 
s 


iequ: call igetvalue Gee ist int Off Suack LO the cx reg 

mov bx, ax ;save value 
call igetvalue Paet 2nd value using the stack ptr 
emp ax, © 
je eql ;Jump if equal 
MOV ax, FALSE ;put false value into varspace 

Cont: call iputvalue ;Put value into varspace, addr on stacx 
ret 

, 

eql: mov ax, TRUE put true value into varspace 
Neo cont 
ret 


real 


Ne ee ineg RRR KEKE KKK KKK KKK KKK KKK KKK KKK 


;Takes logical not equal of two 


. 
, 


ineq: 


Ov 


call igetvalue 
DX; was 


call igetvalue 


cmp 


neql: 


jmp 
rec 


ax, “Dx 

neql 

ax, PFALSE 
call iputvalue 
mov ax, TRUE 


fal 


integers and stacks address of answer 


sget lst int off stack to the meee 
;save value 
;get second value using stack ptr 


;Jump if equal 


;put false value into varspace 
;Put value into varspace, addr on stacx 


;put true value into varspace 


8 KKK KER KKK KKK KKK KKK KKK KKK OG ee RRR K EK KEKE KKK KKK KKK KEKE KK KKK KK KK KKK KK 


;Takes logical less than of two integers and stacks address of answer 
;Returns true if first value is less than the second value 


e 
’ 


° 
s 


p RR KKK KKK EKKKEKEKKKEKKEEKKK KK 


mov 
Cake 
Eno 
jge 
mov 
con: 
ree 


less: 
jmp 
ret 


call igetvalue 


Dx, ax 
igetvalue 
ax, bx 
less 
ax, TRUE 
call iputvalue 


MOWy ax, evo 
con 


;get ist int off stack to Uhm 
;save value 
sget 2nd value using the Stdaekmea 
,Compare 
;Jump if less 

put false value into varspace 

;Put value into varspace, addr on stack 


s;put true value Gate Vaeeeace 


Igt RK RK KK EK KKK KKK RK KEK KEKE KKK 


;Takes logical greater than of two integers and stacks address of answer 
;Returns true if first value is greater than the second value 


ENp ax, Ox 
jle greater than 
mov ax, TRUE 
cont call iputvalue 
ret 
, 
Greaces nan: - Mev ak, ea loe 
imp oe On: 
Tet 


ts call igetvalue 


MoV 


bx, -ax 


call igetvalue 


get lst int off stacx to themes 
;save value 
sget second value using stack ptr 
;Compare 
jJump if greater than 

sput false value into varspace 

;Put value into varspace, addr on stack 


sput true value into varspace 


pakke a KKK KKK KKK KKK KEK KK KK Ilteq RRR KK RK KKK KKK KKK KKK KKK KEK KKK 


;Takes logical S$ of two integers and stacks address of answer 
;Returns true if first value is less than or equal to the second value 


eq: call igetvalue 
mov bx, ax 


Gaul 
Gmo 


igetvalue 
ax, Dx 


jg lteq 


az 


sget lst int off stack to the cree 
;save value 

;get 2nd value using the stack ptr 
;Compare 

;Jump if less to error 


mov ax eR Ue ;put false value into varspace 


Gone: call iputvalue ;PUL valUe InGosvarspace, addr on stacx 
ret 
; 
lteq: mov ax, FALSE ;put true value into varspace 
jmp con2 
mec 


PRR KEKKKKKKKKKKKKKKKKKK KK K [gGteq KKK KKK KKK KK KKK KK KKK KK KKK KKK KKK 
;Takes logical 2 of two integers and stacks address of answer 
;Returns true if first value is greater than or equal to the second 
value 


. 
f 


Igteq: call igetvalue Foee dSe ING eOrr Stack >to Ehe. cx’ reg 
mMoveOx, ax ;save value 
call igetvalue ;get second value using stack ptr 
EMmpiax, Dx ;Compare 
jl gteq ,Jump if greater than or equal to 
mov ax, TRUE ,Pput false value into varspace 

cons; call iputvalue ;Put value into varspace, addr on stack 
ret 
, 

gteq: mov ax, FALSE ;put true value into varspace 
amp cons 
ret 


KKK KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KR KKK KK KKK KKK 
, 

e* (Tnecegqersorerartions ~ 
eK KKKKK KKK KK KKK KKK KKK KKK KKK KKK KK KKK KKK KKK KKK KK KKKKKK KKK KKK KK KK KKK KK 


, 
pRKKKK KKK KKK KK KK KKK KKK KK KK lace KKK KKK KKK KKK KKK KKK KKK KKK KKK KK KKK 


;Adds two integer values 
;Assumes offset off second value is in SI register 
mettset of first value is at the top of the stack 


c 


Fadd ; call igetvalue 
mov bx, ax 
call igetvalue ;First value to cx register 
add ax, bx ,Herrorm addition 
jo err yin Overflow, run time error 
’ 
call iputvalue ;Put integer into varspace 
eS, 
' 
Bie 6 Meee kOe eSee acd err Peeves Nancler sor overt low 


eall prigt’s 
call eoln 
eall finis 
ret 


PRR KKK KKK KKK KKK KKK KKK KK TSub KKK KK KKK KKK KKK KKK KK KKK KKK KKK 


;Subs two integer values 
7Assumes offset off second value is in SI register 
;Offset of first value is at the top of the stack 


f 


suk: call igetvalue 
MOV. DX, ax 
call igetvalue ;First value to cx register 
Sup ax. Ox “Pertorm Subtraction 


3 


PRK KEK KEKKKKKKKKKEKKKKKKKKKE PM 


70 GmEs 

call iputvalue 
ret 

errs: neov-adx, 


cali OrenGcs 
call eoln 
Cal ins 


See 


offset sub err 


;Multiplies two integer values 


;Assumes offset off second value 
*OfLESCE CE ELYSt valtiewls ateene 


e 
g 


e 
> , - 
pS toyl ewes 


call igetvalue 
mov Dx). sax 
call igetvalue 
pigs me oy < 
je°err) 


call iputvalue 


ret 


erri: nov dx, 
Call “prlgces 
call eoln 

call finis 


ECG 


offset mul_err 


;1if overflow, run time error 


;Put integer into varspace 


;Print error message on overflow 


wKaeKR KKK KKK KKK KK KK KKK KKK KKK KKK KKK Kk 


is in SI register 
top of thevseuaen 


;First value to cx register 
;Perform mult, result ia 

sif carry set, run time ernzem 
;Put integer into varspace 

;put error message in dx register 
{perne ue 


send 


PRK KKK KKK KKK KKK KKK KKK KKK [TDEgn kek kkk kkk kkk KKK KKK KK KKK KKK KKK KKK 


;Divides two integer values, 


stacked 
,;Offset of first value is at the top of the stack 


, 


idivn: 


DUSA €x 
pusn Gx 
call igetvalue 
mow Dx 70 ax 


call igetvalue 


KOY "dx, pax 
mov vel 1 
MOMs Chik 
emp ox%,-0 
*g test2 
je errd 
neg-el 

neg bx 


ige dloop 
neg ch 
neg ax 


MD AU 
l done 
Tica 
imp dloop 


Cmp 7ax:,.0 


SUD ax,o% 
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result in varspace, address of result 


;Save Registers 


;Get divisor 
¢MOV GiVisor Eous: 
sGet dividend tomax 


; SEU cx cor 
;cl and ch are negative flags 


;bx is positive, no’action needed 
sox is 0, ERROR 

;bx is negative, cl flag negated 
;ox is made positive 


s;test dividend 

dividend >= 0; ne actiue. 

jax is negative, ch flag negated 
jax is made positive 


sloop and count subtracticene 
;if ax less than 0, done 


store result. ineex 
scontinue legp 


done: mov al, el “MUTE ply ch and ¢€2 


mul cn 
cmp al,0 

jge-aend ;if product not negative, no action 
neg ax else negate answer 

dend: MOV dax,dx 
pop dx 
pop cx 

call iputvalue ;Put integer into varspace 
Loe 
; 

errd: mov dx, offset div_err ;put error message in dx register 
Call printes Por Lie 8 t 
call eoln 
Gallo finis ;end 
ree 


gp RK KKK KKK KEK KKK KKK KKK KKK KKK KK KKK KK KK KKK KK KKKKKKKKKKKKKKKKKKK KKK KK KKK KKK KK 


x . 
:* Function Calling Procedures z 
* _ 


eee wm RK AKA KARE XKRAKRRRERKRRE RRA KEK EKKKKEKKKKAKKEKKKKKEKKKKKKEKKEKKKKKKEKK 


p RRR KRKKKKKKK KE KKK KEKKKKKKKKKK KKK K a. mov KKK RK KK KEKE KKK KKK KEK KK KKK KK KKK KKK KKK 


; Movs integer or boolean actuals with addresses at the top of stack to 
the lowest addresses within a scope 
Assumes bx has number of actuals needed to be moved 


=e 


™e 


i_mov: pep ret addr ;Save i_mov's return address 
call add scope 
Stree: pop dx ;mov addresses to cx and dxi regs 
Bop. CX 
eat! find addr ;Get virtual address of the integer 
MOV cae Cx 
mov ax, eS:Vars [di] ,5et Up ax for “Tassian 
call iassign 
dec bx 
ep. Ox, Oo 
jne strt 
push ret addr ;Restore 1 _mov's return address 


Be 
ree 


RAKE KKKKKKKKKKKK KKK KK 3 towmMa KKK KKK KKK KK KKK KKK KKK KKK KKK KKK KEK KKK 


meats a formal to the top of the stack 
passumes offset of formal in cx register 


feeeckmal: mov di,0 


mov di, s_nest([dil] ;Get nesting level 
call ppush "Push OLESet and nest onto scack 
ret 


PRR KKK KKK KKK KKKK KKK KK KKK KK KKK KKK KEK KK KKK KK KKK KK KKK KEK KK KEK KKEKKKKKKKKEK KKK KK 


ras x 
as Variables * 
° * * 


p RR KKK KKK KKK KKK KKK KKK KKK KKK KKK KKK KEK KK KKK KK KKK KKK KK KKK KK KKK KKK KK KKK KKK 


dseg 


> 


o KKK KKK KKK KK KKK KKK KKK KKK 
sexx Kke Constants KKK* KR KKK KK KKK KEK KKK KKK KKK 


TRUE £O0 1 
BALSE EQU 0 
SPACE, FOP ECU 32700 ;Top of memory space 


PARKER ER KKK KK KEE KA Tnteger Variables Xt eR RRR KKK KK RK KK RK KK 


max offset dw 0 ;Maximum current offset w/in scope 
Cupr vader dw =32700 ;Current maximum address 

sliak dw SPACE TOP ;Current address of static Uua 
s nest dw 0 ;Current static nesting level 


ret adder) wea 
PRR KK KKK KKK KKKKEKKKKKKKKKKEKE ELGLor Messaages KKEKKKKKKEKEKKEKKKKKKEKA KE 


div_err gdb "DIVISION BY ZERO, seen 
dps 's! 
MUL ve or do ‘MULTIPLICATION OVERFLOW, ldters 
(ol mec 
add err ab “ADDITION OVERFLOW, DIMWIT® 
Gip 7 Sos 
SUD ere ab 'SUBTRACTION OVERFLOW, Nilwie 
ab obs 
eras db "STACK/VARIABLE SPACE CRASH‘ 
oo I 


PRK KEKE KK KKK KKK KK KKKKEKE KEKE BEror Messaages KKK KEKE KKK KK KKK KKK KKK KKK KKK KKK 


eseg 
vars dw 0 
end 
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APPENDIX N - TEST SUITE 


SIMPLE TESTS OF FUNCTIONS AND VARIABLES 
letc : $Z -> $Z; 
cieemmiere cll) —— 1 | — 2 (nen on ii 
else 3 +n endif 
--Simple "Hello I'm Alive Test” 
letc: $Z -> $Z; 
Cees yew ere cin) ——n* 5 
-- Test for expression in functions's formals 
let cc: $2 -> $Z: 
c (k + 2) where k == 2 and 


c (n) ==ifn=1 thenn * 3 elsen+ 4 endif 


-- Test for expression in function's formals 


TESTS FOR RECURSION 
leve> oZ,-> $2: 
Gtk “where k == 2 and ¢ (n)==n * 3 


-- Test for expression in function's formals 


letc: $Z -> $Z; 
c (0) where c (n) == if n=O then 1 else c (n - 1) * n endif 


-- Test for recursion in functions 


letc : $Z -> $Z; 
eo where c(i) —=1 m = © then | else c (n - 1) * n endif 


-- Test for recursion in functions 


letc: $Z -> $Z; 


Si 


c (3) where ¢ (n) ==1f n=O'then | elsen > Gin Wenaan 


-- Test for recursion in functions 


letc:$Z==52%) 

c (7) where c (n) ==1f n=O then | elsen* c (1 - Iiendit 

-- Test for recursion in functions 

TESTS OF COMPLEX FUNCTIONS, INCLUDING BOOLEANS AS 
ARGUMENTS AND RESULTS 

letc : $Z -> SB; 


c (1) where 
€() === 6 


-- Test for booleans in function 


letc : $Z * $Z * $Z -> $Z; 
C2 103.4 a witete Culm) =— 1 ~ Mme 


--Test for multiple arguments 


letc :$Z -> SB; 
letd : $Z -> $Z; 


c (1) where 
(ny —— 10a) where 
gtk) == i 


-- Test for chaining in functions 


letc : $Z -> $Z; 

let d : $Z -> $Z; 

lete : $Z -> SB; 

e (3) where 

c (n) == | + d(n) where 
d(k) =="8 et) 
then k else k + 1 endif 
where e (k) ==k =3 


-- Test for nesting in functions 
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let cee$Z ->:$Z; 
letd : $Z -> $Z; 
lete : $Z -> $B; 


c (3) * 10 where 
c (n) == 1 + d(n) where 
d(k) == if e(1) 
then k else k + 1 endif 
where e (k) ==k =3 


-- Test for nesting in functions, result multiplied by constant 


letc : $Z -> $Z: 
letd : $Z -> $Z; 
lete : $Z -> $B; 


c (3) * c(4) where 
c (n) == 1 + d(n) where 
aiei—— re 1) 
then k else k + 1 endif 
Meh he) —— ke — 
and b == 10 


-- Test for two functions, same definition 
-- Also, test for extraneous variable defined at end of program 


let c : $Z -> $Z; 
letd : $Z -> $Z; 
lete: $B -> $B; 


G5) ~ c( 4) where 
c (n) == 1 + d(n) where 
Gi het? = 3 744 = 5) 
then k else k + 1 endif 
Wiener) —— 


-- Test for boolean expression as an actual 


TESTS FOR "AND" AND "WHERE" NESTING AND COMBINATIONS 


letc : $Z -> $Z; 
let d : $Z -> $Z; 
c (3) * b where b == 10 and 
©(m) == n~ d (mn) where 
a —— 


-- Test for nesting in functions 


3, 


let ¢ °$2Z-2 $2; 
letd : $Z -> $Z: 


c (3) * b where b == 0 ana 
© ij=— 1 am witete 
d(i== 3 Se where ec ——me 


-- Test for nesting in functions 


let c : $Z -> $Z; 
letd: $Z -> $Z; 
lete : $Z -> $Z; 


c (3) + b where b == 10 and 
c(n) ==d (1) + iim =e (1 then 2 else ty ena 
where e (k) == -1 and 
d(g)==g+5 


-- Test for nested wheres and ands 


letc : $Z -> $Z; 
letd $7352 
lete : $Z -> $B; 


c (3) where 
c (n) == 1 + d(n) where 
d(k) == if e(1) then k else k + 1 endif 
Where ¢ (0) —— b= 3 


-- Test for nesting in functions 


letc : $Z -> $Z,; 
let d : $Z; 
(>) wnerecc (mn) —— 
and <d== 1) = 5 
-- Test for single and statement 
-- Test for datadef declaration 
letc 232 
let d : $Z; 
lete : $Z; 


c where c ==(d + 10+ e where e == 10) 
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and d == 10 
-- Test for Multiple ands 


let c : $Z; 
let d : $Z; 
lete : $Z,; 


c where c==d +10+€e 
anaed == 10) 
and e == 10 


-- Test for Multiple ands 


letce: $Z-> $Z; 
letd : $Z -> $Z; 
lete : $Z -> $Z; 


Cc oewhererciny) —=— din) + IZ 
and d(s) == 10+s 


-- Test for Multiple ands using functions 


letc : $Z -> $Z,; 
letd : $Z -> $Z, 
lete : $Z -> $Z; 


Coy were cin) ==d(n) + |Z 
and d(s) == 10 +e (s) 
and e(k) == 20 +k +t where t == 100 


-- Test for Multiple ands , nested wheres 


let c : $Z; 
let d : $Z: 
let e : $Z; 


c where c ==d +10+e where 
e—— 1 and «qd == [0 
--Test for Multiple ands 


fee 792 -> Ob: 
letd: $Z->SB; 
letk : $Z -> $Z,; 


161 


c(1) A d(2) where 
e(n) —— a > and 
dy ==" ka ie evitere 
k (1) ==1+ 10) 


-- Test for proper use of "and" and implementation of 
-- Parens 


let ce SZ oe 
letd : $Z -> $Z; 
lete : $Z -> $Z; 


c(5) where c(n) ==d(n) + 12 where k == 100 
and d(s) == 10 +e (s) 
and e(k) == 20 + k 


-- Test for Multiple ands, multiple wheres and formal/vaniable collisions 


letc SZ -> $2: 
letd : $Z -> $Z; 
lete : $Z -> $Z; 


c(5) where c(n) ==d(n) + 12 where k == 100 
and d(s) == 10 +e (s) where t == 100 
and e(k) ==20 +k +t 


-- Test for Multiple ands, multiple wheres and formal/vaniable collisions 


letc : $Z -> $Z,; 
letd $7254. 
lete : $Z -> $Z; 


c(5) where c(n) ==d(n) + 12 where t == 100 
and dis) —==10 + eS) where t —— 120 
and e(k) ==20+k+t 


-- Test for Multiple ands, multiple wheres and formal/vaniable collisions 
-- Also test to see if the proper "t" (120) was picked up 


letc : $Z * $Z -> $Z; 
letd: $Z * $Z -> $Z; 
lete : $Z * $Z -> $Z; 


c(5,1) where c(n,m) == d(n,m) + 12 where t == 100 
and d(s,z) == 10 +e (s,z) where t == 120 
and e(k,l) == 20 +k +t+1 


-- Test for Multiple ands, muluple wheres and formal/vaniable collisions 
-- Test specifically for functions with multiple arguments 


letc : $Z -> $Z; 
letd : $Z -> $Z; 
lete : $Z -> $Z; 


c(5) where c(n) ==d(n) where t == 100 
and d(s) == (e (s) where k == 2) 
and e(k) == 20 +t 


-- Test for Multiple ands, multiple wheres and formal/variable collisions 


letc : $Z -> $Z; 
letd : $Z ->$Z; 
lete : $Z->$Z; 


c(10) where c(n) == d(n) where t == 100 
and d(s) == e(s) where k == 10 
and e(r) == 20+r+k 


-- Test for Multiple ands, multiple wheres and formal/variable collisions 


let c : $Z -> $Z; 
let d : $Z -> $Z; 
lete : $Z -> $Z; 


Gi) ewihenre scum) == d(n) +t where t == (r * 100 where r == 2) 
aia d( Ss) == e(S)ev ere k——10 
and e(r) == 20 +r+k 


-- Test for Multiple ands, multiple wheres and formal/variable collisions 


letc : $Z -> $Z; 
letd : $Z -> $Z; 
lete : $Z -> $Z; 
let f: SN -> $Z; 


c(10) where c(n) == d(n) +t where t == (r * 100 where r == 2) 


anded(s) == (s) where k == 10 
and e(r) == 20 +r +f (r) 
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and f(r) == 


-- Test for Multiple ands, multiple wheres and formal/variable collisions 


letc : $Z -> $Z; 
let d : $Z -> $Z; 
leteoZ == $7: 
let f£: $N -> $Z; 


c(10) where c(n) == d(n) + t where t == (r * 100 where r == 2) 
and d(s)i== € (Ss) where k == 10 
and e(r) == 20+ r+ f (r) 
and f(r) == 


-- Test for Multiple ands, multiple wheres and formal/vanable collisions 


letc: $Z->$Z; 
letd :3$Z ->$Z; 
leve jZ.-2 7, 
let f: $N -> $Z; 


c(10) where c(n) == d(n) +t where t == (r * 100 where r == 2) 
and d(s)——¢ (Ss) where k == 10 
and e(r) == 20 + r + f(r) 
and f(r) ==if r= O then 100 else f (r - 1) endif 


-- Test for Multiple ands, multiple wheres and formal/variable collisions 
-- Test for if-then-else collisions with multiple ands, wheres 


letc : $Z -> $Z; 
let di tZa 2. 
lete : $Z -> $Z; 
let f£: $N -> $Z; 
let zebra : $Z; 


c(10) where c(n) == d(n) +t where t ==( * LOU Where — = 
and d(s) == (e (s) where k == 10 
and e(r) == 20 + r + f(r) + zebra 
and f@) ==if r= 0 then 100 else Gaal renain 
and zebra == t) 


-- Test for Multiple ands, multiple wheres and formal/vanable collisions 


-- Test for if-then-else collisions with multiple ands, wheres 


letc : $Z -> $Z; 
letd : $Z -> $Z; 
lete : $Z -> $Z; 
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c(5) where c(n) ==d(n) + 12 where t == 100 
and d(s) == (10 +e (s) where k == 100 
and e(k) == 20 + k + t) 


--Note the use of parenthesis here : if they are removed, the program will 
--bomb because t will be undefined 


ERROR TESTING 


let x :$z; 
let j:$Z; 
let i:$z; 


1 where 1 ==x%j 


and x ==5 and j == 


-- Gives Division by Zero run time error 


let b:Sb; 
let 1:$Z; 
let j:$z; 
let n:$n; 
let x: $2; 
if b then 1 
elsif ~(b Ab) then j 
else x endif where 

b == 1=2 where 

i ==0 

and where } 

and where z == 69 
-- Gives two parser errors : line 13 and 14, } undefined and 
-- where following "and" 


let fac : $N -> $N; 
fac (5) where fac (n) == fac (n - 1) 
-- Check for stack overflow 


too_much where too_much == 1000 * 1000 


-- Check for Multiplication Overflow 


too_much where too_much == 30000 + 30000 
-- Check for Addition overflow 
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too_much where too_much == -30000 - 30000 


-- Check for Subtraction Overflow 


letc :$Z -> $B; 
letd : $Z -> $B; 
let k2$Z-= 2. 
let g :$Z -> $Z; 


GCL) /\ed(2 aw itere 
an) == (ee) winere 
k (1) ==1+ 10) and 
¢ (n) == 3 


-- Test for proper use of comments; note that there is no 
delimiter on the second line of comments, as there should 


MISCELLANEOUS TESTS 


let b:$b; 
let 1:$Z; 
letjepz: 
let n:$n; 
let x: $z; 
if (b VY ~b) then i 
elsif (b V ~b) then } 
else x endif where 
== j=2 where 
1 ==) 
and j = 
and x == 69 


-- Test for not construct, boolean constructs 


let b:Sb; 
let i:$Z; 
let og: 
let n:$n; 
let x: $z; 


if ~(b V ~b) then 1 
elsif ~(b A~b) then j 
else x endif where 


== 1=2 where 
1==0 
and ] —— 
and x =—— 09 
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-- should give 2 

-- Check and, or, notand, notor 

-- Check if, else, elseif 

-- Especially, check all in combination 


let a:$Z; 

let b:$2z; 

let y:$n; 

let x: $z; 

let f: $n*$n->$n; 

let times : $n*$n->$n; 


f(30,30) where 


f(a,b) == times(a,b) where 

times(x,y) == x*y 

-- Multiargument Checking 

-- Natural Type Checking 

let a:$Z; 

let b:$2z; 

let y:$z; 

let x: $2z; 


let f: $z*$z->$z; 
let umes : $n*$n->$z; 


{(30,4) where 
f(a) —— iiitiesia,O) where 
times(x,y) == 
i 1 — 1) then xy 
else 2 endif end 
-- Integer Division Checking 


letc : $Z -> $B; 
letd: $Z -> $B; 
let k : $Z -> SZ; 
let g: $Z ->$Z; 


c(1) A d(2) where 
d (n) == (1 = k {m - 1) where 
k (1) == 1+ 10) and 
Cin) ===, 3 


-- Test for proper use of "and" and implementation of 
-- Parens 
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APPENDIX O - ROCK COMPILER USER'S MANUAL 


Ie Installation 


The rock compiler program comes ona 5.25" disk with all 
public domain programs necessary torun it. To install this 
program on another floppy disk or a hard disk, use the following 


procedures: 


1) Change the system drive to the disk drive containing the 
floppy disk. 


2) Type "INSTALL", followed by a space and the drive and 
directory on which you want the program installed. 


Note that the Rock compiler uses three unsupplied files to 
operate: RASM86, LINK&6, and your choice of word processor. The 
RASM86 and LINK86 programs must be installed on the same 
directory as the compiler. 


II. Running the Compiler 


a. Type in "ROCK" and wait for the screen display shown in 
figure 1 to appear. 


ROCK COMPILER 
Press Escape Key to Exit Compiler 


Program to Compile -> 





Figure 1 


b. When the prompt appears, type in the file name of the 
source file you want to compile, then press return. The 
compiler will accept directory specifications in the 

file designation. If the source file is found, the 
compilation will begin immediately, and the screen will 
appear as shown in figure 2. If the file is not found, 

the screen will appear as shown in figure 3. 
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c. If a successful compilation takes place, the prompt for 
a source file reappears. If the compilation is not 
successful, error messages will appear on the screen, 
and a copy of these messages can be found in a file 


ROCK COMPILER 
Press Escape Key to Exit Compiler 


Program to Compile -> SQRT.PHI 


Compiling: Please Wait 





Figure 2 


ROCK COMPILER 
Press Escape Key to Exit Compiler 


Program to Compile -> NOTFOUND 


File not Found 
Press ESCAPE to exit, any other key to continue 





Figure 3 
named Errors.Phi. A typical error display 1s shown in 


figure 4. After perusing the errors, you may press any 
key to return to the prompt for a source file. 
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ROCKY ERRORS 


line 1: formals list missing or error in formals list 


line 1: misplaced or missing == 
number of errors = 2 


PRESS ANY KEY TO CONTINUE 





Figure 4 


d. If compilation is successful, both an .exe and an .obj 

file will be created. In the event that an error 

occurs, neither file will be created. 

WARNING : If vou choose to compile two programs with the 
same prefix, ensure you save the first one before 
compiling the second one; otherwise, the second 
compilation will overwrite the output file of the first 
compilation. 


e. To cleanly stop the compiler, press the ESCAPE key any 
time the system asks for an input. If you have started 

to compile a program and you need a ‘panic” exit, press 
"Control-Break". If you do this, the cursor will not 
reappear on the screen. However, you can get it back by 
running the ROCK program again and making a normal exit. 


lil. Error Handling 


Errors are divided into two categories : those found during 
compilation and those found during run time. The following two 
sections list the errors messages from both categories which you 
might encounter. Each message includes a bref synopsis of what 
causes the error. 


COMPILER ERRORS 


Message Explanation 


ia ad Ht A] 


incomplete ‘I->' Either an "!" or "I-" was found 
where "I->" was expected. 


\' without following 7, A single backslash was found 
logical OR is 'V' where a logical or construct 
(VY) was expected. 
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'$' without following 
imeoN . 2. Bor Files 
invalid numeric 
Constant ==> 3. 


literal without ending 


unidentfied char 
in input program ==> # 


MEMORY OVERFLOW 
DURING COMPILATION 


error in statement 
following ==> * 


error in type 
definition following ==> * 


unable to complete 
definition of blockbody 
after keyword LET 


missing or misplaced ';' 
after definition 


valid qualexp/exp 
not found in the def/auxdef 


valid typeexp not found 
in the def 


formals list missing 
or error in formals list 


misplaced or missing ')' 

at least one identfier 

must follow keyword TYPE 
unable to complete 


def/auxdef following 
keyword AND 


An incomplete type declaration was found. 


An ulegal constant was found; 
in this example, "3." 


An unterminated literal was 
found, or a literal spanned 
more than one line. 


A character with no meaning was 
found in the source file; '#', in this example. 


The source program is too big 


for the host machine to compile. 


An iulegal statement follows 
the specified character; '*', in the example. 


An illegal type definition follows the 
specified character; '*', in the example. 
An unspecified error was found 

after LET, and the compiler is 

so completely sandbagged that 


it cannot recover. 


A declaration, preceded by 
"LET", was not followed by a semicolon. 


An invalid expression was found 
An expression defining a 
type was either missing or incorrect. 


Formals were expected but not found, 
or formals were incompletely specified. 


A PHI keyword or delimiter was 
expected or not found; ')' in the example. 


TYPE found without an identifier. 


Improper or no expression found 
following AND. 


missing or invalid auxdef 
after keyword WHERE 


missing or misplaced 
closing paren in formals 
list 


error in processing 
multiple Actuals 


missing literal 
after keyword FILE 


missing or invalid 
exp following KEYWORD 


IF statement w/o ENDIF 


error in formals 
preceding |-> 


missing or invalid 
QualExp following 
COMMA operator 


error in ArgBinding 


- check QualExp 
or closing bracket 


OZONE LEVEE! - 


NUMERIC VALUE EXPECTED 


NATURAL EXPECTED 


INTEGER OR NATURAL EXPECTED 


ERROR IN TUPLE DEFINITION 


UNDEFINED VARIABLE 
IN AND SCOPE 


Improper or no definition following 
WHERE 


Formals found without closing 
parenthesis. 


One actual was found, but an 
error was spotted in a subsequent actual. 


FILE was found without a file- 
name being designated. 


A keyword was spotted, but the 
following expression was illegal. 


No ENDIF to close off an IF statement. 


"|->" found, but the formals 
list preceding it contained an error. 


A list of elements was found 
with an illegal expression in it. 


An improper expression in an 

argument binding was found, or 

the closing bracket on an argument binding 
was not found. 


Unimplemented feature found. 
for 19.99 the feature can be 
implemented in 1999 


Non-numeric type found where a 
numeric type was expected. 


Natural type was not found where 
it was expected. 


Either an integer or natural type 
is proper, but neither was found. 


A tuple is improperly defined : 

the source file used improper 

types or number of types in defining 

the tuple. This can also mean 

a single variable was improperly defined. 


An undefined variable was found 
in one of the two branches of an 


in itS scope. 


FUNCTION WITHOUT A function was defined without a 
FUNCTION DEFINITION declaration of its type and formals. 
FORMALS MISMATCHED Formals in a function definition 


are not the same in either type or 
number as those in the function's declaration. 


FUNCTION CALLED WITHOUT No function definition found for 


FUNCTION DEFINITION the function called. 

REAL NUMBER EXPECTED An incorrect type was found where 
a real number was expected. 

INVALID CONSTANT An invalid constant was found. 

EXPRESSION 

BOOLEAN VALUE EXPECTED A boolean value was expected, but 


none was found. 


BOOLEAN OPERATOR EXPECTED _ A boolean operator was expected, 
but none was found. 


OUT OF RUN-TIME Not enough space to accommodate the 

MEMORY SPACE program during run-time. 
RUN-TIME ERRORS 

DIVISION BY ZERO Division by zero attempted. 


MULTIPLICATION OVERFLOW A multiplication operation resulted in 
a numeric value outside the language limits. 


ADDITION OVERFLOW An addition operation resulted in 
a numeric value outside the language limits. 


SUBTRACTION OVERFLOW A subtraction operation resulted 
in a numeric value outside the 
language limits. 


STACK/VARIABLE SPACE CRASH _ The stack overwrote the variable space. 
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